Snippets

John Peck Create an arc of boxes with xfig

Created by John Peck
#!/opt/ActiveTcl-8.6/bin/tclsh
# Hey Emacs, use -*- Tcl -*- mode

# ---------------------- Command line parsing -------------------------
package require cmdline
set usage "usage: boxarc \[options]"
set options {
    {l.arg 100 "Box length (mils)"}
    {w.arg 100 "Box width (mils)"}
    {d.arg 50 "Minimum depth"}
    {r.arg 1000 "Arc radius (mils)"}
    {s.arg 0 "Start angle (degrees)"}
    {e.arg 90 "End angle (degrees)"}
    {n.arg 10 "Number of boxes"}
    {o.arg "none" "Output file name"}
}

try {
    array set params [::cmdline::getoptions argv $options $usage]
} trap {CMDLINE USAGE} {msg o} {
    # Trap the usage signal, print the message, and exit the application.
    # Note: Other errors are not caught and passed through to higher levels!
    puts $msg
    exit 1
}

if { [string equal $params(o) "none"] } {
    # Output file hasn't been specified
    set outfile $params(l)x$params(w)_$params(r)r_$params(n)n_$params(d)d.fig
} else {
    set outfile $params(o)
}

# Open the output file
try {
    set fp [open $outfile w]
} trap {} {msg o} {
    puts $msg
    exit 1
}

# pi constant
set pi 3.1415926535897932385

# Pixels per inch
set ppi 1200

set header "
#FIG 3.2  Produced by xfig version 3.2.5c
Landscape
Center
Inches
Letter
100.00
Single
-2
$ppi 2
"

# Set colors starting with 32
set colors "
0 32 #ff0000
0 33 #00ff00
0 34 #c2c2c3
"

proc write_lines {file_pointer data} {
    set linelist [split $data "\n"]
    foreach line $linelist {
	if {[string length $line] > 0} {
	    # Refuse to write blank lines
	    puts $file_pointer $line
	}
    }
}

proc draw_box {x_inch y_inch rotation_rad color} {
    # Return the two xfig file lines that define the box
    #
    # Arguments:
    #   x_inch -- x-position of the box's center (inches)
    #   y_inch -- y-position of the box's center (inches)
    #   rotation_rad -- Rotation of the box (radians)
    #   color -- one of green, red, or off
    global params
    global pi
    global ppi
    # 2 -- Polyline object code
    # 1 -- Polyline subtype
    # 0 -- Line style
    # 1 -- Thickness
    # 0 -- Pen color
    # xx -- Fill color
    if {[string equal $color red]} {
	set colorcode 32
    } elseif {[string equal $color green]} {
	set colorcode 33
    } elseif {[string equal $color off]} {
	set colorcode 34
    } else {
	set colorcode 34
    }
    set boxblock "2 1 0 1 0 $colorcode "
    # Set the depth
    append boxblock "$params(d) "
    # -1 -- Pen style (not used)
    # 20 -- Area fill
    # 0.000 -- Style value
    # 0 -- Join style
    # 0 -- Cap style
    # -1 -- Radius of arc-box (-1 turns this off)
    # 0 -- Forward arrow (0 for off)
    # 0 -- Backward arrow (0 for off)
    # 5 -- Points in the polyline
    append boxblock "-1 20 0.000 0 0 -1 0 0 5\n"
    append boxblock "\t "
    # Compute radius in mils
    set radius_mils [expr sqrt(($params(l)/2)**2 + ($params(w)/2)**2)]

    # Upper right corner
    set theta1_rad [expr atan2($params(w),$params(l))]
    set x1_noshift_inch [expr ($radius_mils * cos($theta1_rad + $rotation_rad)) / 1000]
    set x1 [expr round(($x1_noshift_inch + $x_inch) * $ppi)]
    set y1_noshift_inch [expr ($radius_mils * sin($theta1_rad + $rotation_rad)) / 1000]
    set y1 [expr round(($y1_noshift_inch + $y_inch) * $ppi)]
    append boxblock "$x1 $y1 "
    # Upper left corner
    set theta2_rad [expr $pi - $theta1_rad]
    set x2_noshift_inch [expr ($radius_mils * cos($theta2_rad + $rotation_rad)) / 1000]
    set x2 [expr round(($x2_noshift_inch + $x_inch) * $ppi)]
    set y2_noshift_inch [expr ($radius_mils * sin($theta2_rad + $rotation_rad)) / 1000]
    set y2 [expr round(($y2_noshift_inch + $y_inch) * $ppi)]
    append boxblock "$x2 $y2 "
    # Lower left corner
    set x3_noshift_inch [expr -1 * $x1_noshift_inch]
    set x3 [expr round(($x3_noshift_inch + $x_inch) * $ppi)]
    set y3_noshift_inch [expr -1 * $y1_noshift_inch]
    set y3 [expr round(($y3_noshift_inch + $y_inch) * $ppi)]
    append boxblock "$x3 $y3 "
    # Lower right corner
    set x4_noshift_inch [expr -1 * $x2_noshift_inch]
    set x4 [expr round(($x4_noshift_inch + $x_inch) * $ppi)]
    set y4_noshift_inch [expr -1 * $y2_noshift_inch]
    set y4 [expr round(($y4_noshift_inch + $y_inch) * $ppi)]
    append boxblock "$x4 $y4 "
    # Upper right corner (again)
    append boxblock "$x1 $y1 "
    return $boxblock
}

proc deg_to_rad {degrees} {
    # Return the radian value
    #
    # Arguments:
    #   degrees -- Angle in degrees
    set pi 3.1415926535897932385
    set radians [expr $degrees * $pi/180]
    return $radians
}

proc rad_to_deg {radians} {
    # Return the degree value
    #
    #
    # Arguments:
    #   radians -- Angle in radians
    set pi 3.1415926535897932385
    set degrees [expr $radians * 180/$pi]
    return $degrees
}

proc get_radian_list {} {
    # Return a list of angles (radians) at which boxes will be placed
    #
    # Arguments:
    #
    global params
    global pi
    global ppi
    set span_deg [expr abs($params(s) - $params(e))]
    set stepsize_deg [expr double($span_deg) / ($params(n) - 1)]
    set numsteps $params(n)
    # The first angle will always be the start angle parameter
    set radian_list [list]
    for {set i 0} {$i < $numsteps} {incr i} {
	if {$params(e) > $params(s)} {
	    lappend radian_list [deg_to_rad [expr ($params(s) + $i * $stepsize_deg)]]
	} else {
	    lappend radian_list [deg_to_rad [expr ($params(s) - $i * $stepsize_deg)]]
	}
    }
    return $radian_list
}

proc mils_to_fig {mils} {
    # Return the fig length
    #
    # Arguments:
    #   mils -- Length in mils (0.001 inch)
    set ppi 1200
    set figlength [expr round($ppi * double($mils)/1000)]
    return $figlength
}

proc get_x_centers {radian_list} {
    # Return a list of x center positions in inches
    #
    # Arguments:
    #
    #   radian_list -- List of angles to box centers
    global params
    set x_center_list_inch [list]
    foreach angle $radian_list {
	lappend x_center_list_inch [expr $params(r) * cos($angle) / 1000]
    }
    return $x_center_list_inch
}

proc get_y_centers {radian_list} {
    # Return a list of y center positions in inches
    #
    # Arguments:
    #
    #   radian_list -- List of angles to box centers
    global params
    global pi
    global ppi
    set y_center_list_inch [list]
    foreach angle $radian_list {
	lappend y_center_list_inch [expr $params(r) * sin($angle)/1000]
    }
    return $y_center_list_inch
}

proc get_bounding_box {boxline_list} {
    # Return four coordinates to define the drawing's bounding box
    #
    # Arguments:
    #   boxline_list -- List of lines in the drawing
    foreach line $boxline_list {
	set coords_string [string trim [lindex [split $line "\n"] 1]]
	foreach {x y} $coords_string {
	    if [info exists xmin] {
		if {$x < $xmin} {
		    set xmin $x
		}
	    } else {
		set xmin $x
	    }
	    if [info exists xmax] {
		if {$x > $xmax} {
		    set xmax $x
		}
	    } else {
		set xmax $x
	    }
	    if [info exists ymin] {
		if {$y < $ymin} {
		    set ymin $y
		}
	    } else {
		set ymin $y
	    }
	    if [info exists ymax] {
		if {$y > $ymax} {
		    set ymax $y
		}
	    } else {
		set ymax $y
	    }
	}
    }
    return "$xmin $ymin $xmax $ymax"
}

# Write the file header
write_lines $fp $header

# Write the custom colors
write_lines $fp $colors

set radian_list [get_radian_list]
set x_center_list_inch [get_x_centers $radian_list]
set y_center_list_inch [get_y_centers $radian_list]
set boxline_list [list]

foreach angle $radian_list xpos $x_center_list_inch ypos $y_center_list_inch {
    lappend boxline_list [draw_box $xpos $ypos $angle "green"]
}
set bounding_box [get_bounding_box $boxline_list]
write_lines $fp "6 ${bounding_box}\n"
foreach line $boxline_list {
    write_lines $fp $line
}
write_lines $fp "-6"
close $fp

Comments (1)

  1. John Peck

    To draw an arc of 20 0.063 x 0.031 inch boxes from -180 degrees to 90 degrees with a radius of 1.5 inches:

    tclsh boxarc.tcl -r 1500 -l 63 -w 31 -n 20 -s 180 -e 90

    Capture.JPG

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.