5 # User Interface that generates custom QFP and SOIC packages for pcb-1.6.3
6 # Invoked from a line like
7 # esyscmd(qfp-ui $1 $2 $3)
8 # within an m4 macro triggered by pcb-1.6.3
9 # depends on having the Right [TM] m4 macro PKG_QFP in qfp.inc
10 # Copyright 1999 Larry Doolittle <LRDoolittle@lbl.gov>
12 # SOIC support added Jan 2000 Larry Doolittle
13 # Use nX==0 for that mode.
15 # Parts library added Feb 2000 Larry Doolittle
16 # That feature is still rough, but it is useful, and you get the idea
18 # Refinement of library file usage Mar 2000 Larry Doolittle
19 # Peeks at the X resource Pcb.libraryPath, uses that for a search path
20 # for qfp.dat. Appends .:$HOME to that path, and writes any updates
21 # (via the "Save" button) to $HOME/qfp.dat only.
24 # have someone else test it enough to know what needs fixing
25 # proper support for changing pin 1 location
26 # more choices of outline (at least inboard vs. outboard)
27 # more packages in default qfp.dat, double checked and tested
29 global description boardname partnum
30 set description [ lindex $argv 0 ]
31 set boardname [ lindex $argv 1 ]
32 set partnum [ lindex $argv 2 ]
34 # scaling and centering for canvas;
35 # I use max_pix=380 for big screens, and trim it down to 266 for
36 # use on my 640x480 laptop.
37 # I've never seen any QFP exceed 36 mm, so max_mm=38 should be safe.
41 set s [ expr $max_pix/$max_mm*.0254 ]
42 set c [ expr 0.5*$max_pix ]
44 # fixme ... maybe put in a search path? Get from environment?
45 set libwritedir "$env(HOME)"
47 set libpath ".:$libwritedir"
49 set libwritefile "$libwritedir/qfp.dat"
51 # default values of the actual parameters that describe the QFP
52 global istart nX nY pitch pwidth plength lX lY
62 # Define the native units for each dimension
63 # dm is "decimicrons" :-) allows exact conversion from microns or mils
64 foreach v {pwidth plength lX lY} {
71 set factor(inch) 254000
76 proc m4define { name val } {
77 puts "define(`$name', $val)"
80 proc spit_output { } {
81 global description boardname partnum
82 global pkgname istart nX nY pitch pwidth plength lX lY
84 m4define PAD_LENGTH $plength
85 m4define PAD_WIDTH $pwidth
86 m4define ISTART $istart
91 puts "PKG_GEN_QFP($description, $boardname, $partnum)"
95 proc state_encode { } {
96 global description boardname partnum
97 global pkgname istart nX nY pitch pwidth plength lX lY
98 return "$pitch $plength $pwidth $istart $nX $nY $lX $lY $partnum $description"
101 proc state_decode { s } {
102 global description boardname partnum
103 global pkgname istart nX nY pitch pwidth plength lX lY
104 regexp {([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([^ ]+) (.*)} $s dummy\
105 pitch plength pwidth istart nX nY lX lY partnum description
108 proc woohoo { x y } {
110 catch { .p.txt tag delete mine }
111 set loc [ .p.txt index "@$x,$y" ]
112 regexp {([0-9]*)\.} $loc dummy l
113 # puts "woo-hoo $x $y $loc $l"
114 regexp {([^ ]+)} [ .p.txt get $l.0 "$l.0 lineend" ] dummy k
115 if { [ catch { state_decode $library($k) } ] } return
116 .p.txt tag add mine $l.0 "$l.0 lineend"
117 .p.txt tag configure mine -background red
122 proc libfiles_read { } {
124 if { [ catch { set fd [ open "| appres Pcb" ] } ] } return
125 while { [ gets $fd line ] != -1 } {
126 regexp {([a-zA-Z.]+):[ ] *([^ ]*)} $line dummy res_name res_value
127 if { $res_name == "Pcb.libraryPath" } {
128 set libpath "$res_value:$libpath"
132 foreach f [ split $libpath ":" ] { libfile_read "$f/qfp.dat" }
135 proc libfile_read { filename } {
137 if { [ catch { set fd [ open $filename ] } ] } return
138 while { [ gets $fd line ] != -1 } {
139 regexp {[0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ ([^ ]+) .*} $line dummy pn
140 set library($pn) $line
145 proc load_library { } {
146 global library libline
147 if { [ catch { toplevel .p } ] } return
148 wm title .p "qfp-ui-library"
150 button .p.b.dismiss -text "Dismiss" -command "destroy .p"
151 pack .p.b.dismiss -side left
152 pack .p.b -side bottom
153 text .p.txt -width 40 -height 15 -font fixed \
154 -yscrollcommand ".p.sbar set"
155 scrollbar .p.sbar -command ".p.txt yview"
156 pack .p.txt -side left -fill both -expand 1
157 pack .p.sbar -side right -fill y
158 catch { unset libline }
160 set keys [ lsort [ array names library ] ]
162 regexp {[0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ ([^ ]+) (.*)} $library($d) dummy pn desc
163 paint_lib_entry $pn $desc
165 .p.txt configure -state disabled
166 bind .p.txt <Button> "woohoo %x %y"
169 proc save_library { } {
170 global library partnum description libwritefile
172 .p.txt configure -state normal
173 paint_lib_entry $partnum $description
174 .p.txt configure -state disabled
176 set library($partnum) [ state_encode ]
178 set fd [ open $libwritefile "a+" ]
179 puts $fd [ state_encode ]
184 proc paint_lib_entry { p desc } {
186 if { [ catch { set l $libline($p) } ] } {
187 set loc [ .p.txt index "end -1 lines" ]
188 regexp {([0-9]*)\.} $loc dummy libline($p)
189 .p.txt insert end "$p $desc\n"
191 .p.txt delete $l.0 "$l.0 lineend"
192 .p.txt insert $l.0 "$p $desc"
196 proc uconvert { v in out } {
197 # puts "$v $in converted to $out"
199 set answer [ expr ($v*$factor($in))/$factor($out) ]
204 proc qupdate { v unit } {
205 global $v ${v}_inch ${v}_mm ${v}_native
206 set screen "${v}_${unit}"
207 set newuser [ expr \$$screen ]
208 # compute the exact result in mils
209 set native [ expr \$${v}_native ]
210 # puts "$v $unit $newuser $native"
211 if { ! [catch { set new [ uconvert $newuser $unit $native ] } ] } {
217 proc line_update { v new } {
218 global $v ${v}_inch ${v}_mm ${v}_native
219 set native [ expr \$${v}_native ]
220 # puts "$v $new $native"
221 set new [ expr round($new) ]
223 set inch [ uconvert $new.0 $native inch ]
224 set mm [ uconvert $new.0 $native mm ]
225 set ${v}_inch [ format "%.3f" $inch]
226 set ${v}_mm [ format "%.2f" $mm]
232 if { ! [ catch { set new [ expr round(\$$v) ] } ] } {
239 proc push_state_to_screen { } {
240 global pitch pwidth plength lX lY
241 foreach v {pitch pwidth plength lX lY} {
242 line_update $v [ expr \$$v ]
246 # Trickery with the part number, make it follow the live pin count,
247 # until and unless the user makes the name not include QFP-xxx.
248 # The magic value "menu" matches the third column of our entry in generic.list
249 proc part_update { } {
251 set pincount [ expr 2*($nX+$nY) ]
252 set newstring "QFP-$pincount"
253 if { $partnum == "menu" } {
254 set partnum $newstring
256 regsub -all {QFP-[0-9]+} $partnum $newstring partnum
260 proc adjustment { w number title varname } {
266 entry $f.number -textvariable $number -width 4
267 bind $f.number <FocusOut> "nupdate $varname"
268 bind $f.number <Return> "nupdate $varname"
270 label $f.label -text $title
271 global ${varname}_mm ${varname}_inch
272 entry $f.mm -textvariable "${varname}_mm" -width 8
273 entry $f.inch -textvariable "${varname}_inch" -width 8
274 pack $f.inch $f.mm $f.label $f.number -side right
275 pack $f -side top -anchor e
276 bind $f.inch <FocusOut> "qupdate $varname inch"
277 bind $f.inch <Return> "qupdate $varname inch"
278 bind $f.mm <FocusOut> "qupdate $varname mm"
279 bind $f.mm <Return> "qupdate $varname mm"
282 proc draw_pad { x y wx wy } {
284 set x1 [ expr round($c+$s*($x-0.5*$wx)) ]
285 set y1 [ expr round($c+$s*($y-0.5*$wy)) ]
286 set x2 [ expr round($x1+$s*$wx) ]
287 set y2 [ expr round($y1+$s*$wy) ]
288 # puts "rectangle $x1 $x2 $y1 $y2"
289 .c create rectangle $x1 $y1 $x2 $y2 \
290 -fill black -outline ""
293 proc draw_line { x1 y1 x2 y2 } {
295 .c create line [ expr $c+$s*$x1 ] [ expr $c+$s*$y1 ] \
296 [ expr $c+$s*$x2 ] [ expr $c+$s*$y2 ] \
297 -fill white -width 2.0
300 proc draw_dot { x y } {
303 .c create oval [ expr $c+$s*$x-$r ] [ expr $c+$s*$y-$r ] \
304 [ expr $c+$s*$x+$r ] [ expr $c+$s*$y+$r ] \
305 -fill white -outline ""
308 proc draw_pad_line { n x y dx dy wx wy } {
309 # puts "$n $x $y $dx $dy $wx $wy"
310 for { set i 0} {$i<$n} {incr i} {
311 draw_pad [ expr $x+$i*$dx ] [ expr $y+$i*$dy ] $wx $wy
315 proc draw_outline { } {
317 # use floating point mils for these calculations
318 global pitch nX nY lX lY plength pwidth
319 set p [expr $pitch.0/254 ]
320 set xmin [expr -0.5*($lX-$plength) ]
321 set xmax [expr 0.5*($lX-$plength) ]
322 set ymin [expr -0.5*($lY-$plength) ]
323 set ymax [expr 0.5*($lY-$plength) ]
324 set xstart [ expr -0.5*$p*($nX-1) ]
325 set ystart [ expr -0.5*$p*($nY-1) ]
326 draw_pad_line $nX $xstart $ymin $p 0 $pwidth $plength
327 draw_pad_line $nY $xmin $ystart 0 $p $plength $pwidth
328 draw_pad_line $nX $xstart $ymax $p 0 $pwidth $plength
329 draw_pad_line $nY $xmax $ystart 0 $p $plength $pwidth
332 draw_dot [ expr $xmin+1.5*$plength ] $ystart
334 # package outline: handle SOIC cases, too
335 set adj [ expr (($nY>0)-.5)*$plength+15 ]
336 set xmin [expr $xmin+$adj ]
337 set xmax [expr $xmax-$adj ]
339 set adj [ expr (($nX>0)-.5)*$plength+15 ]
340 set ymin [expr $ymin+$adj ]
341 set ymax [expr $ymax-$adj ]
343 draw_line $xmin $ymin $xmin $ymax
344 draw_line $xmax $ymin $xmax $ymax
345 draw_line $xmin $ymin $xmax $ymin
346 draw_line $xmin $ymax $xmax $ymax
351 proc infoline { w text var } {
355 entry $win.var -textvariable $var
356 label $win.id -text $text
357 pack $win.var $win.id -side right
358 pack $win -side top -anchor e
362 # label .debug1 -text "$argv"
363 # label .debug2 -text "$env(PATH)"
364 # pack .debug1 .debug2
368 label .a.header.inch -text "inch" -width 8
369 label .a.header.mm -text "mm" -width 8
370 pack .a.header.inch .a.header.mm -side right
371 pack .a.header -side top -anchor e
372 adjustment .a "" "Pitch" pitch
373 adjustment .a "" "Pad Width" pwidth
374 adjustment .a "" "Pad Length" plength
375 adjustment .a nX "X length" lX
376 adjustment .a nY "Y length" lY
379 infoline "" "Description: " description
380 infoline "" "Name on board: " boardname
381 infoline "" "Part Number: " partnum
384 button .b.done -text "Done" -command spit_output
385 button .b.load -text "Library" -command load_library
386 button .b.save -text "Save" -command save_library
387 # pcb-1.6.3 gronks with no input from library, so we can't
388 # give the user this option.
389 # button .b.cancel -text "Cancel" -command exit
390 pack .b.done .b.load .b.save -side right
393 canvas .c -width $max_pix -height $max_pix
395 label .whoami1 -text "Experimental QFP UI for pcb-1.6.3"
396 label .whoami2 -text "by Larry Doolittle <LRDoolittle@lbl.gov>"
397 pack .whoami1 .whoami2