Snippets
Created by
John Peck
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | #!/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 (2)
You can clone a snippet to your computer for local editing. Learn more.
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
Sighing in slope game does not say is not ignorant. Sometimes it's because you keep running after you see us being tasteless.