lib/qfp-ui.in

   1 #!@WISH@ -f
   2
   3 #
   4 # User Interface that generates custom QFP and SOIC packages for pcb-1.6.3
   5 # Invoked from a line like
   6 #   esyscmd(qfp-ui $1 $2 $3)
   7 # within an m4 macro triggered by pcb-1.6.3
   8 # depends on having the Right [TM] m4 macro PKG_QFP in qfp.inc
   9 # Copyright 1999 Larry Doolittle  <LRDoolittle@lbl.gov>
  10 #
  11 # SOIC support added Jan 2000 Larry Doolittle
  12 # Use nX==0 for that mode.
  13 #
  14 # Parts library added Feb 2000 Larry Doolittle
  15 # That feature is still rough, but it is useful, and you get the idea
  16 #
  17 # Refinement of library file usage Mar 2000 Larry Doolittle
  18 # Peeks at the X resource Pcb.libraryPath, uses that for a search path
  19 # for qfp.dat.  Appends .:$HOME to that path, and writes any updates
  20 # (via the "Save" button) to $HOME/qfp.dat only.
  21 #
  22 # Wish list:
  23 #   have someone else test it enough to know what needs fixing
  24 #   proper support for changing pin 1 location
  25 #   more choices of outline (at least inboard vs. outboard)
  26 #   more packages in default qfp.dat, double checked and tested
  27
  28 global description boardname partnum
  29 set description [ lindex $argv 0 ]
  30 set boardname   [ lindex $argv 1 ]
  31 set partnum     [ lindex $argv 2 ]
  32
  33 # scaling and centering for canvas;
  34 # I use max_pix=380 for big screens, and trim it down to 266 for
  35 # use on my 640x480 laptop.
  36 # I've never seen any QFP exceed 36 mm, so max_mm=38 should be safe.
  37 set max_mm 38
  38 set max_pix 266
  39 global s c
  40 set s [ expr $max_pix/$max_mm*.0254 ]
  41 set c [ expr 0.5*$max_pix ]
  42
  43 # fixme ... maybe put in a search path?  Get from environment?
  44 set libwritedir "$env(HOME)"
  45 global libpath
  46 set libpath ".:$libwritedir"
  47 global libwritefile
  48 set libwritefile "$libwritedir/qfp.dat"
  49
  50 # default values of the actual parameters that describe the QFP
  51 global istart nX nY pitch pwidth plength lX lY
  52 set istart  1
  53 set nX      32
  54 set nY      32
  55 set pitch   8000
  56 set pwidth  10
  57 set plength 50
  58 set lX      1290
  59 set lY      1290
  60
  61 # Define the native units for each dimension
  62 # dm is "decimicrons" :-) allows exact conversion from microns or mils
  63 foreach v {pwidth plength lX lY} {
  64         global ${v}_native
  65         set ${v}_native mil
  66 }
  67 global pitch_native
  68 set pitch_native dm
  69
  70 set factor(inch)  254000
  71 set factor(mm)    10000
  72 set factor(mil)   254
  73 set factor(dm)    1
  74
  75 proc m4define { name val } {
  76         puts "define(`$name', $val)"
  77 }
  78
  79 proc spit_output { } {
  80         global description boardname partnum
  81         global pkgname istart nX nY pitch pwidth plength lX lY
  82         m4define PITCH      $pitch
  83         m4define PAD_LENGTH $plength
  84         m4define PAD_WIDTH  $pwidth
  85         m4define ISTART     $istart
  86         m4define XPADS      $nX
  87         m4define YPADS      $nY
  88         m4define X_LENGTH   $lX
  89         m4define Y_LENGTH   $lY
  90         puts "PKG_GEN_QFP($description, $boardname, $partnum)"
  91         exit
  92 }
  93
  94 proc state_encode { } {
  95         global description boardname partnum
  96         global pkgname istart nX nY pitch pwidth plength lX lY
  97         return "$pitch $plength $pwidth $istart $nX $nY $lX $lY $partnum $description"
  98 }
  99
 100 proc state_decode { s } {
 101         global description boardname partnum
 102         global pkgname istart nX nY pitch pwidth plength lX lY
 103         regexp {([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([^ ]+) (.*)} $s dummy\
 104                 pitch plength pwidth istart nX nY lX lY partnum description
 105 }
 106
 107 proc woohoo { x y } {
 108         global library
 109         catch { .p.txt tag delete mine }
 110         set loc [ .p.txt index "@$x,$y" ]
 111         regexp {([0-9]*)\.} $loc dummy l
 112         # puts "woo-hoo $x $y $loc $l"
 113         regexp {([^ ]+)} [ .p.txt get $l.0 "$l.0 lineend" ] dummy k
 114         if { [ catch { state_decode $library($k) } ] } return
 115         .p.txt tag add mine $l.0 "$l.0 lineend"
 116         .p.txt tag configure mine -background red
 117         push_state_to_screen
 118         draw_outline
 119 }
 120
 121 proc libfiles_read { } {
 122         global libpath home
 123         if { [ catch { set fd [ open "| appres Pcb" ] } ] } return
 124         while { [ gets $fd line ] != -1 } {
 125                 regexp {([a-zA-Z.]+):[  ] *([^  ]*)} $line dummy res_name res_value
 126                 if { $res_name == "Pcb.libraryPath" } {
 127                         set libpath "$res_value:$libpath"
 128                 }
 129         }
 130         close $fd
 131         foreach f [ split $libpath ":" ] { libfile_read "$f/qfp.dat" }
 132 }
 133
 134 proc libfile_read { filename } {
 135         global library
 136         if { [ catch { set fd [ open $filename ] } ] } return
 137         while { [ gets $fd line ] != -1 } {
 138                 regexp {[0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ ([^ ]+) .*} $line dummy pn
 139                 set library($pn) $line
 140         }
 141         close $fd
 142 }
 143
 144 proc load_library { } {
 145         global library libline
 146         if { [ catch { toplevel .p } ] } return
 147         wm title .p "qfp-ui-library"
 148         frame .p.b
 149         button .p.b.dismiss -text "Dismiss" -command "destroy .p"
 150         pack .p.b.dismiss -side left
 151         pack .p.b -side bottom
 152         text .p.txt -width 40 -height 15 -font fixed \
 153                     -yscrollcommand ".p.sbar set"
 154         scrollbar .p.sbar -command ".p.txt yview"
 155         pack .p.txt  -side left  -fill both -expand 1
 156         pack .p.sbar -side right -fill y
 157         catch { unset libline }
 158         libfiles_read
 159         set keys [ lsort [ array names library ] ]
 160         foreach d $keys {
 161                 regexp {[0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ ([^ ]+) (.*)} $library($d) dummy pn desc
 162                 paint_lib_entry $pn $desc
 163         }
 164         .p.txt configure -state disabled
 165         bind .p.txt <Button> "woohoo %x %y"
 166 }
 167
 168 proc save_library { } {
 169         global library partnum description libwritefile
 170         catch {
 171                 .p.txt configure -state normal
 172                 paint_lib_entry $partnum $description
 173                 .p.txt configure -state disabled
 174         }
 175         set library($partnum) [ state_encode ]
 176         catch {
 177                 set fd [ open $libwritefile "a+" ]
 178                 puts $fd [ state_encode ]
 179                 close $fd
 180         }
 181 }
 182
 183 proc paint_lib_entry { p desc } {
 184         global libline
 185         if { [ catch { set l $libline($p) } ] } {
 186                 set loc [ .p.txt index "end -1 lines" ]
 187                 regexp {([0-9]*)\.} $loc dummy libline($p)
 188                 .p.txt insert end "$p $desc\n"
 189         } else {
 190                 .p.txt delete $l.0 "$l.0 lineend"
 191                 .p.txt insert $l.0 "$p $desc"
 192         }
 193 }
 194
 195 proc uconvert { v in out } {
 196         # puts "$v $in converted to $out"
 197         global factor
 198         set answer [ expr ($v*$factor($in))/$factor($out) ]
 199         # puts "   = $answer"
 200         return $answer
 201 }
 202
 203 proc qupdate { v unit } {
 204         global $v ${v}_inch ${v}_mm ${v}_native
 205         set screen "${v}_${unit}"
 206         set newuser [ expr \$$screen ]
 207         # compute the exact result in mils
 208         set native [ expr \$${v}_native ]
 209         # puts "$v $unit $newuser $native"
 210         if { ! [catch { set new [ uconvert $newuser $unit $native ] } ] } {
 211                 line_update $v $new
 212                 draw_outline
 213         }
 214 }
 215
 216 proc line_update { v new } {
 217         global $v ${v}_inch ${v}_mm ${v}_native
 218         set native [ expr \$${v}_native ]
 219         # puts "$v $new $native"
 220         set new [ expr round($new) ]
 221         set $v $new
 222         set inch [ uconvert $new.0 $native inch ]
 223         set mm   [ uconvert $new.0 $native mm   ]
 224         set ${v}_inch [ format "%.3f" $inch]
 225         set ${v}_mm   [ format "%.2f" $mm]
 226 }
 227
 228 proc nupdate { v } {
 229         global $v
 230
 231         if { ! [ catch { set new [ expr round(\$$v) ] } ] } {
 232                 set $v $new
 233                 draw_outline
 234                 part_update
 235         }
 236 }
 237
 238 proc push_state_to_screen { } {
 239         global pitch pwidth plength lX lY
 240         foreach v {pitch pwidth plength lX lY} {
 241                 line_update $v [ expr \$$v ]
 242         }
 243 }
 244
 245 # Trickery with the part number, make it follow the live pin count,
 246 # until and unless the user makes the name not include QFP-xxx.
 247 # The magic value "menu" matches the third column of our entry in generic.list
 248 proc part_update { } {
 249         global partnum nX nY
 250         set pincount [ expr 2*($nX+$nY) ]
 251         set newstring "QFP-$pincount"
 252         if { $partnum == "menu" } {
 253                 set partnum $newstring
 254         } else {
 255                 regsub -all {QFP-[0-9]+} $partnum $newstring partnum
 256         }
 257 }
 258
 259 proc adjustment { w number title varname } {
 260         set f "$w.$varname"
 261         frame $f
 262         if {$number == ""} {
 263                 frame $f.number
 264         } else {
 265                 entry $f.number -textvariable $number -width 4
 266                 bind $f.number <FocusOut> "nupdate $varname"
 267                 bind $f.number <Return>   "nupdate $varname"
 268         }
 269         label $f.label -text $title
 270         global ${varname}_mm ${varname}_inch
 271         entry $f.mm   -textvariable "${varname}_mm"   -width 8
 272         entry $f.inch -textvariable "${varname}_inch" -width 8
 273         pack  $f.inch $f.mm $f.label $f.number -side right
 274         pack $f -side top -anchor e
 275         bind $f.inch <FocusOut> "qupdate $varname inch"
 276         bind $f.inch <Return>   "qupdate $varname inch"
 277         bind $f.mm   <FocusOut> "qupdate $varname mm"
 278         bind $f.mm   <Return>   "qupdate $varname mm"
 279 }
 280
 281 proc draw_pad { x y wx wy } {
 282         global s c
 283         set x1 [ expr round($c+$s*($x-0.5*$wx)) ]
 284         set y1 [ expr round($c+$s*($y-0.5*$wy)) ]
 285         set x2 [ expr round($x1+$s*$wx) ]
 286         set y2 [ expr round($y1+$s*$wy) ]
 287         # puts "rectangle $x1 $x2 $y1 $y2"
 288         .c create rectangle $x1 $y1 $x2 $y2 \
 289                 -fill black -outline ""
 290 }
 291
 292 proc draw_line { x1 y1 x2 y2 } {
 293         global s c
 294         .c create line [ expr $c+$s*$x1 ] [ expr $c+$s*$y1 ] \
 295                        [ expr $c+$s*$x2 ] [ expr $c+$s*$y2 ] \
 296                         -fill white -width 2.0
 297 }
 298
 299 proc draw_dot { x y } {
 300         global s c
 301         set r 5
 302         .c create oval [ expr $c+$s*$x-$r ] [ expr $c+$s*$y-$r ] \
 303                        [ expr $c+$s*$x+$r ] [ expr $c+$s*$y+$r ] \
 304                 -fill white  -outline ""
 305 }
 306
 307 proc draw_pad_line { n x y dx dy wx wy } {
 308         # puts "$n $x $y $dx $dy $wx $wy"
 309         for { set i 0} {$i<$n} {incr i} {
 310                 draw_pad [ expr $x+$i*$dx ]  [ expr $y+$i*$dy ] $wx $wy
 311         }
 312 }
 313
 314 proc draw_outline { } {
 315         .c delete all
 316         # use floating point mils for these calculations
 317         global pitch nX nY lX lY plength pwidth
 318         set p [expr $pitch.0/254 ]
 319         set xmin [expr -0.5*($lX-$plength) ]
 320         set xmax [expr  0.5*($lX-$plength) ]
 321         set ymin [expr -0.5*($lY-$plength) ]
 322         set ymax [expr  0.5*($lY-$plength) ]
 323         set xstart [ expr -0.5*$p*($nX-1) ]
 324         set ystart [ expr -0.5*$p*($nY-1) ]
 325         draw_pad_line $nX $xstart $ymin $p 0 $pwidth $plength
 326         draw_pad_line $nY $xmin $ystart 0 $p $plength $pwidth
 327         draw_pad_line $nX $xstart $ymax $p 0 $pwidth $plength
 328         draw_pad_line $nY $xmax $ystart 0 $p $plength $pwidth
 329
 330         # crude pin 1 marker
 331         draw_dot [ expr $xmin+1.5*$plength ] $ystart
 332
 333         # package outline: handle SOIC cases, too
 334         set adj [ expr (($nY>0)-.5)*$plength+15 ]
 335         set xmin [expr $xmin+$adj ]
 336         set xmax [expr $xmax-$adj ]
 337
 338         set adj [ expr (($nX>0)-.5)*$plength+15 ]
 339         set ymin [expr $ymin+$adj ]
 340         set ymax [expr $ymax-$adj ]
 341
 342         draw_line $xmin $ymin $xmin $ymax
 343         draw_line $xmax $ymin $xmax $ymax
 344         draw_line $xmin $ymin $xmax $ymin
 345         draw_line $xmin $ymax $xmax $ymax
 346 }
 347
 348 push_state_to_screen
 349
 350 proc infoline { w text var } {
 351         set win $w.$var
 352         global $var
 353         frame $win
 354         entry $win.var -textvariable $var
 355         label $win.id  -text $text
 356         pack $win.var $win.id -side right
 357         pack $win -side top -anchor e
 358 }
 359
 360
 361 # label .debug1 -text "$argv"
 362 # label .debug2 -text "$env(PATH)"
 363 # pack .debug1 .debug2
 364
 365 frame .a
 366 frame .a.header
 367 label .a.header.inch -text "inch"  -width 8
 368 label .a.header.mm   -text "mm"    -width 8
 369 pack  .a.header.inch .a.header.mm -side right
 370 pack  .a.header -side top -anchor e
 371 adjustment .a ""   "Pitch"       pitch
 372 adjustment .a ""   "Pad Width"   pwidth
 373 adjustment .a ""   "Pad Length"  plength
 374 adjustment .a nX   "X length"    lX
 375 adjustment .a nY   "Y length"    lY
 376 pack .a -pady 5
 377
 378 infoline "" "Description: "   description
 379 infoline "" "Name on board: " boardname
 380 infoline "" "Part Number: "   partnum
 381
 382 frame .b
 383 button .b.done   -text "Done"     -command spit_output
 384 button .b.load   -text "Library"  -command load_library
 385 button .b.save   -text "Save"     -command save_library
 386 # pcb-1.6.3 gronks with no input from library, so we can't
 387 # give the user this option.
 388 # button .b.cancel -text "Cancel" -command exit
 389 pack .b.done .b.load .b.save -side right
 390 pack .b -pady 5
 391
 392 canvas .c -width $max_pix -height $max_pix
 393 pack .c
 394 label .whoami1 -text "Experimental QFP UI for pcb-1.6.3"
 395 label .whoami2 -text "by Larry Doolittle <LRDoolittle@lbl.gov>"
 396 pack .whoami1 .whoami2
 397 draw_outline
 398 part_update