3
# $Id: qfp-ui.in,v 1.1.1.1 2003/02/20 00:23:32 danmc Exp $
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
added
removed
lib/qfp-ui.in
