lib/qfp-ui.in

   1 #!@WISH@ -f
   2
   3 # $Id$
   4 #
   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>
  11 #
  12 # SOIC support added Jan 2000 Larry Doolittle
  13 # Use nX==0 for that mode.
  14 #
  15 # Parts library added Feb 2000 Larry Doolittle
  16 # That feature is still rough, but it is useful, and you get the idea
  17 #
  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.
  22 #
  23 # Wish list:
  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
  28
  29 global description boardname partnum
  30 set description [ lindex $argv 0 ]
  31 set boardname   [ lindex $argv 1 ]
  32 set partnum     [ lindex $argv 2 ]
  33
  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.
  38 set max_mm 38
  39 set max_pix 266
  40 global s c
  41 set s [ expr $max_pix/$max_mm*.0254 ]
  42 set c [ expr 0.5*$max_pix ]
  43
  44 # fixme ... maybe put in a search path?  Get from environment?
  45 set libwritedir "$env(HOME)"
  46 global libpath
  47 set libpath ".:$libwritedir"
  48 global libwritefile
  49 set libwritefile "$libwritedir/qfp.dat"
  50
  51 # default values of the actual parameters that describe the QFP
  52 global istart nX nY pitch pwidth plength lX lY
  53 set istart  1
  54 set nX      32
  55 set nY      32
  56 set pitch   8000
  57 set pwidth  10
  58 set plength 50
  59 set lX      1290
  60 set lY      1290
  61
  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} {
  65         global ${v}_native
  66         set ${v}_native mil
  67 }
  68 global pitch_native
  69 set pitch_native dm
  70
  71 set factor(inch)  254000
  72 set factor(mm)    10000
  73 set factor(mil)   254
  74 set factor(dm)    1
  75
  76 proc m4define { name val } {
  77         puts "define(`$name', $val)"
  78 }
  79
  80 proc spit_output { } {
  81         global description boardname partnum
  82         global pkgname istart nX nY pitch pwidth plength lX lY
  83         m4define PITCH      $pitch
  84         m4define PAD_LENGTH $plength
  85         m4define PAD_WIDTH  $pwidth
  86         m4define ISTART     $istart
  87         m4define XPADS      $nX
  88         m4define YPADS      $nY
  89         m4define X_LENGTH   $lX
  90         m4define Y_LENGTH   $lY
  91         puts "PKG_GEN_QFP($description, $boardname, $partnum)"
  92         exit
  93 }
  94
  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"
  99 }
 100
 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
 106 }
 107
 108 proc woohoo { x y } {
 109         global library
 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
 118         push_state_to_screen
 119         draw_outline
 120 }
 121
 122 proc libfiles_read { } {
 123         global libpath home
 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"
 129                 }
 130         }
 131         close $fd
 132         foreach f [ split $libpath ":" ] { libfile_read "$f/qfp.dat" }
 133 }
 134
 135 proc libfile_read { filename } {
 136         global library
 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
 141         }
 142         close $fd
 143 }
 144
 145 proc load_library { } {
 146         global library libline
 147         if { [ catch { toplevel .p } ] } return
 148         wm title .p "qfp-ui-library"
 149         frame .p.b
 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 }
 159         libfiles_read
 160         set keys [ lsort [ array names library ] ]
 161         foreach d $keys {
 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
 164         }
 165         .p.txt configure -state disabled
 166         bind .p.txt <Button> "woohoo %x %y"
 167 }
 168
 169 proc save_library { } {
 170         global library partnum description libwritefile
 171         catch {
 172                 .p.txt configure -state normal
 173                 paint_lib_entry $partnum $description
 174                 .p.txt configure -state disabled
 175         }
 176         set library($partnum) [ state_encode ]
 177         catch {
 178                 set fd [ open $libwritefile "a+" ]
 179                 puts $fd [ state_encode ]
 180                 close $fd
 181         }
 182 }
 183
 184 proc paint_lib_entry { p desc } {
 185         global libline
 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"
 190         } else {
 191                 .p.txt delete $l.0 "$l.0 lineend"
 192                 .p.txt insert $l.0 "$p $desc"
 193         }
 194 }
 195
 196 proc uconvert { v in out } {
 197         # puts "$v $in converted to $out"
 198         global factor
 199         set answer [ expr ($v*$factor($in))/$factor($out) ]
 200         # puts "   = $answer"
 201         return $answer
 202 }
 203
 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 ] } ] } {
 212                 line_update $v $new
 213                 draw_outline
 214         }
 215 }
 216
 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) ]
 222         set $v $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]
 227 }
 228
 229 proc nupdate { v } {
 230         global $v
 231
 232         if { ! [ catch { set new [ expr round(\$$v) ] } ] } {
 233                 set $v $new
 234                 draw_outline
 235                 part_update
 236         }
 237 }
 238
 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 ]
 243         }
 244 }
 245
 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 { } {
 250         global partnum nX nY
 251         set pincount [ expr 2*($nX+$nY) ]
 252         set newstring "QFP-$pincount"
 253         if { $partnum == "menu" } {
 254                 set partnum $newstring
 255         } else {
 256                 regsub -all {QFP-[0-9]+} $partnum $newstring partnum
 257         }
 258 }
 259
 260 proc adjustment { w number title varname } {
 261         set f "$w.$varname"
 262         frame $f
 263         if {$number == ""} {
 264                 frame $f.number
 265         } else {
 266                 entry $f.number -textvariable $number -width 4
 267                 bind $f.number <FocusOut> "nupdate $varname"
 268                 bind $f.number <Return>   "nupdate $varname"
 269         }
 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"
 280 }
 281
 282 proc draw_pad { x y wx wy } {
 283         global s c
 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 ""
 291 }
 292
 293 proc draw_line { x1 y1 x2 y2 } {
 294         global s c
 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
 298 }
 299
 300 proc draw_dot { x y } {
 301         global s c
 302         set r 5
 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 ""
 306 }
 307
 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
 312         }
 313 }
 314
 315 proc draw_outline { } {
 316         .c delete all
 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
 330
 331         # crude pin 1 marker
 332         draw_dot [ expr $xmin+1.5*$plength ] $ystart
 333
 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 ]
 338
 339         set adj [ expr (($nX>0)-.5)*$plength+15 ]
 340         set ymin [expr $ymin+$adj ]
 341         set ymax [expr $ymax-$adj ]
 342
 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
 347 }
 348
 349 push_state_to_screen
 350
 351 proc infoline { w text var } {
 352         set win $w.$var
 353         global $var
 354         frame $win
 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
 359 }
 360
 361
 362 # label .debug1 -text "$argv"
 363 # label .debug2 -text "$env(PATH)"
 364 # pack .debug1 .debug2
 365
 366 frame .a
 367 frame .a.header
 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
 377 pack .a -pady 5
 378
 379 infoline "" "Description: "   description
 380 infoline "" "Name on board: " boardname
 381 infoline "" "Part Number: "   partnum
 382
 383 frame .b
 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
 391 pack .b -pady 5
 392
 393 canvas .c -width $max_pix -height $max_pix
 394 pack .c
 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
 398 draw_outline
 399 part_update