1#------------------------------------------------------- 2# Useful tools for the Tcl-based version of magic 3#------------------------------------------------------- 4# This file is included by wrapper.tcl if it is found 5# in the magic install directory. 6#------------------------------------------------------- 7 8# Suspend and resume drawing in windows 9# Modified 8/17/04 so that calls to suspendall and resumeall 10# may nest. 11# Modified 11/23/16 12# Modified 12/30/16 to add automatic button accelerator text 13 14proc magic::suspendall {} { 15 global Winopts 16 if {[info commands winfo] != ""} { 17 foreach window [magic::windownames layout] { 18 if {$window == 0} {continue} 19 set framename [winfo toplevel $window] 20 if {$framename == "."} { 21 set framename $window 22 } 23 if {[incr Winopts(${framename},suspend)] == 1} { 24 $window update suspend 25 } 26 } 27 } 28} 29 30proc magic::resumeall {} { 31 global Winopts 32 if {[info commands winfo] != ""} { 33 foreach window [magic::windownames layout] { 34 if {$window == 0} {continue} 35 set framename [winfo toplevel $window] 36 if {$framename == "."} { 37 set framename $window 38 } 39 if {$Winopts($framename,suspend) <= 0} { 40 error "resume called without suspend" 41 } else { 42 incr Winopts($framename,suspend) -1 43 if { $Winopts(${framename},suspend) <= 0 } { 44 unset Winopts(${framename},suspend) 45 $window update resume 46 } 47 } 48 } 49 } 50} 51 52#-------------------------------------------------------------------------- 53# Crash backups. Create a new crash recovery backup every 10 minutes, or 54# at the interval specified by Opts(backupinterval) 55#-------------------------------------------------------------------------- 56 57proc magic::makecrashbackup {} { 58 global Opts 59 60 *bypass crash save 61 if {![catch set Opts(backupinterval)]} { 62 if {$Opts(backupinterval) > 0} { 63 after $Opts(backupinterval) magic::makecrashbackup 64 } 65 } 66} 67 68#---------------------------------------------------------------- 69# magic::crashbackups --- 70# 71# Create periodic backups. Options are: 72# 73# start: Begin periodic backups. If interval is not 74# specified, then set interval to 10 minutes. 75# 76# resume: Resume periodic backups if started and stopped, 77# but not if disabled or never started. 78# 79# stop: Stop periodic backups. 80# 81# disable: Disable periodic backups; set to state of 82# never having been started. 83# 84#---------------------------------------------------------------- 85 86proc magic::crashbackups {{option start}} { 87 global Opts 88 89 switch -exact $option { 90 start { 91 if {[catch set Opts(backupinterval)]} { 92 set Opts(backupinterval) 600000 93 } 94 if {$Opts(backupinterval) > 0} { 95 after $Opts(backupinterval) magic::makecrashbackup 96 } 97 } 98 resume { 99 if {![catch set Opts(backupinterval)]} { 100 if {$Opts(backupinterval) > 0} { 101 after $Opts(backupinterval) magic::makecrashbackup 102 } 103 } 104 } 105 stop - 106 cancel { 107 after cancel magic::makecrashbackup 108 } 109 disable { 110 after cancel magic::makecrashbackup 111 unset Opts(backupinterval) 112 } 113 } 114} 115 116#-------------------------------------------------------------------------- 117# Push and Pop---Treat the edit hierarchy like a stack. 118#-------------------------------------------------------------------------- 119 120proc magic::pushstack {{name ""}} { 121 global editstack 122 if {$name == ""} { 123 # no cell selected, so see if we can select one 124 set selected [what -list] 125 if {[llength [lindex $selected 2]] == 0} { 126 pushbox 127 select cell 128 popbox 129 } 130 set name [cellname list self] 131 } 132 133 if {$name == ""} { 134 error "No cell to push!" 135 } elseif {[llength $name] > 1} { 136 error "Too many cells selected!" 137 } 138 if {[catch {lindex $editstack end}]} { 139 set editstack {} 140 } 141 lappend editstack [view get] 142 lappend editstack [cellname list window] 143 set ltag [tag load] 144 tag load {} 145 load $name 146 catch {magic::cellmanager} 147 catch {magic::captions} 148 tag load $ltag 149 return 150} 151 152proc magic::popstack {} { 153 global editstack 154 if {[llength $editstack] == 0} { 155 error "No subcell stack!" 156 } else { 157 set ltag [tag load] 158 tag load {} 159 suspendall 160 load [lindex $editstack end] 161 set snaptype [snap] 162 snap internal 163 view [lindex $editstack end-1] 164 snap $snaptype 165 catch {magic::cellmanager} 166 catch {magic::captions} 167 resumeall 168 tag load $ltag 169 set editstack [lrange $editstack 0 end-2] 170 } 171 return 172} 173 174proc magic::clearstack {} { 175 global editstack 176 set editstack {} 177} 178 179# More stacking stuff---stacked box values 180 181#--------------------------------------------------------------------- 182# pushbox -- 183# Remember the current box values 184# 185#--------------------------------------------------------------------- 186 187proc magic::pushbox {{values {}}} { 188 global boxstack 189 set snaptype [snap list] 190 snap internal 191 if {[catch {set boxstack}]} { 192 set boxstack {} 193 } 194 if {$values == {}} { 195 lappend boxstack [box values] 196 } else { 197 lappend boxstack $values 198 } 199 snap $snaptype 200 return 201} 202 203#--------------------------------------------------------------------- 204# popbox -- 205# Recall the last pushed box position 206# 207# Option "type" may be empty, or "size" or "position" to pop a specific 208# box size or position without affecting the other box parameters. 209#--------------------------------------------------------------------- 210 211proc magic::popbox {{type values}} { 212 global boxstack 213 set snaptype [snap list] 214 snap internal 215 if {[catch {set boxstack}]} { 216 error "No stack" 217 } elseif {$boxstack == {}} { 218 error "Empty stack" 219 } 220 set b [lindex $boxstack end] 221 switch -exact $type { 222 values { 223 box values [lindex $b 0] [lindex $b 1] [lindex $b 2] [lindex $b 3] 224 } 225 size { 226 box size [expr {[lindex $b 2] - [lindex $b 0]}] \ 227 [expr {[lindex $b 3] - [lindex $b 1]}] 228 } 229 position { 230 box position [lindex $b 0] [lindex $b 1] 231 } 232 } 233 set boxstack [lrange $boxstack 0 end-1] 234 snap $snaptype 235 return $b 236} 237 238#--------------------------------------------------------------------- 239# peekbox -- 240# Shell procedure that calls popbox but follows by pushing the 241# popped value back onto the stack, resulting in a "peek" mode. 242# 243# Options are the same as for "popbox" (see above). 244#--------------------------------------------------------------------- 245 246proc magic::peekbox {{type values}} { 247 global bidx 248 if {![catch {set b [magic::popbox $type]}]} { 249 magic::pushbox $b 250 } else { 251 error "No stack" 252 } 253 return $b 254} 255 256#--------------------------------------------------------------------- 257# Automatic handling of menu button accelerator text 258#--------------------------------------------------------------------- 259 260proc magic::button_auto_bind_text {framename} { 261 set macrolist [string trimleft [string trimright \ 262 [string map {magic:: {}} [macro list -reverse]]]] 263 set macrodict [dict create {*}${macrolist}] 264 set menutop [winfo children ${framename}.titlebar.mbuttons] 265 foreach menub $menutop { 266 set menuw [lindex [winfo children $menub] 0] 267 set items [$menuw index end] 268 for {set i 0} {$i <= $items} {incr i} { 269 set itype [$menuw type $i] 270 if {$itype == "command"} { 271 set icmd [string trimleft [string trimright \ 272 [string map {magic:: {}} [$menuw entrycget $i -command]]]] 273 if {![catch {set keyname [dict get $macrodict $icmd]}]} { 274 set canonname [string map \ 275 {Control_ ^ XK_ {} less < more > comma , question ?}\ 276 $keyname] 277 $menuw entryconfigure $i -accelerator "(${canonname})" 278 } else { 279 $menuw entryconfigure $i -accelerator "" 280 } 281 } 282 } 283 } 284} 285 286#--------------------------------------------------------------------- 287# Text auto-increment and auto-decrement 288#--------------------------------------------------------------------- 289 290proc magic::autoincr {{amount 1}} { 291 set mtext [macro list .] 292 set num [regexp -inline {[+-]*[[:digit:]]+} $mtext] 293 if {$num != ""} { 294 incr num $amount 295 regsub {[+-]*[[:digit:]]+} $mtext $num mtext 296 eval $mtext 297 macro . "$mtext" 298 } 299} 300 301magic::macro XK_plus {magic::autoincr 1} 302magic::macro XK_minus {magic::autoincr -1} 303 304#--------------------------------------------------------------------- 305# The following several routines are designed to aid in generating 306# documentation for technology files, or to generate design rule 307# documents using magic layout windows in a Tk tabbed-window 308# framework. 309#--------------------------------------------------------------------- 310 311#--------------------------------------------------------------------- 312# Ruler generation using the "element" command 313# A line with arrows is drawn showing the dimension of the cursor box. 314# The text of "text", if non-NULL, is placed in the middle of the 315# ruler area. The orientation of "orient" describes whether the 316# ruler is a vertical or horizontal measurement. By default, the 317# longest dimension of the box is the orientation. 318#--------------------------------------------------------------------- 319 320proc magic::ruler {{text {}} {orient auto}} { 321 global Opts 322 323 if {[catch {set Opts(rulers)}]} { 324 set Opts(rulers) 0 325 } else { 326 incr Opts(rulers) 327 } 328 329 set bv [box values] 330 set llx [lindex $bv 0] 331 set lly [lindex $bv 1] 332 set urx [lindex $bv 2] 333 set ury [lindex $bv 3] 334 335 set width [expr {[lindex $bv 2] - [lindex $bv 0]}] 336 set height [expr {[lindex $bv 3] - [lindex $bv 1]}] 337 if {$orient == "auto"} { 338 if {$width > $height} { 339 set orient "horizontal" 340 } else { 341 set orient "vertical" 342 } 343 } 344 345 if {[llength $text] > 0} { 346 if {$orient == "horizontal"} { 347 set tclr 4 348 } else { 349 set tclr 2 350 } 351 } else { 352 set tclr 0 353 } 354 355 set mmx [expr {($llx + $urx) / 2}] 356 set mmy [expr {($lly + $ury) / 2}] 357 358 if {$orient == "horizontal"} { 359 element add line l1_$Opts(rulers) black $llx $lly $llx $ury 360 element add line l4_$Opts(rulers) black $urx $lly $urx $ury 361 362 set mmx1 [expr {$mmx - $tclr}] 363 set mmx2 [expr {$mmx + $tclr}] 364 if {$mmx1 == $llx} {set mmx1 [expr {$llx - 2}]} 365 if {$mmx2 == $urx} {set mmx2 [expr {$urx + 2}]} 366 367 element add line l2_$Opts(rulers) black $llx $mmy $mmx1 $mmy 368 element add line l3_$Opts(rulers) black $mmx2 $mmy $urx $mmy 369 370 if {$tclr > 0} { 371 element add text t_$Opts(rulers) black $mmx $mmy $text 372 } 373 if {$llx < $mmx1} { 374 element configure l2_$Opts(rulers) flags arrowleft 375 } else { 376 element configure l2_$Opts(rulers) flags arrowright 377 } 378 if {$urx > $mmx2} { 379 element configure l3_$Opts(rulers) flags arrowright 380 } else { 381 element configure l3_$Opts(rulers) flags arrowleft 382 } 383 384 } else { 385 element add line l1_$Opts(rulers) black $llx $lly $urx $lly 386 element add line l4_$Opts(rulers) black $llx $ury $urx $ury 387 388 set mmy1 [expr {$mmy - $tclr}] 389 set mmy2 [expr {$mmy + $tclr}] 390 if {$mmy1 == $lly} {set mmy1 [expr {$lly - 2}]} 391 if {$mmy2 == $ury} {set mmy2 [expr {$ury + 2}]} 392 393 element add line l2_$Opts(rulers) black $mmx $lly $mmx $mmy1 394 element add line l3_$Opts(rulers) black $mmx $mmy2 $mmx $ury 395 396 if {$tclr > 0} { 397 element add text t_$Opts(rulers) black $mmx $mmy $text 398 } 399 if {$lly < $mmy1} { 400 element configure l2_$Opts(rulers) flags arrowbottom 401 } else { 402 element configure l2_$Opts(rulers) flags arrowtop 403 } 404 if {$ury > $mmy2} { 405 element configure l3_$Opts(rulers) flags arrowtop 406 } else { 407 element configure l3_$Opts(rulers) flags arrowbottom 408 } 409 } 410} 411 412#--------------------------------------------------------------------- 413# Automatic measurement ruler 414#--------------------------------------------------------------------- 415 416proc magic::measure {{orient auto}} { 417 418 set scale [cif scale out] 419 420 set bv [box values] 421 set llx [lindex $bv 0] 422 set lly [lindex $bv 1] 423 set urx [lindex $bv 2] 424 set ury [lindex $bv 3] 425 426 set width [expr {[lindex $bv 2] - [lindex $bv 0]}] 427 set height [expr {[lindex $bv 3] - [lindex $bv 1]}] 428 if {$orient == "auto"} { 429 if {$width > $height} { 430 set orient "horizontal" 431 } else { 432 set orient "vertical" 433 } 434 } 435 436 if {$orient == "horizontal"} { 437 set tval [expr {$scale * $width}] 438 } else { 439 set tval [expr {$scale * $height}] 440 } 441 set text [format "%g um" $tval] 442 ruler $text $orient 443} 444 445#--------------------------------------------------------------------- 446# Remove all rulers (this should probably be refined to remove 447# just the rulers under the box). 448#--------------------------------------------------------------------- 449 450proc magic::unmeasure {} { 451 set blist [element inbox] 452 set mlist {} 453 foreach m $blist { 454 switch -regexp $m { 455 l[1-4]_[0-9] { 456 lappend mlist [string range $m 3 end] 457 } 458 t_[0-9] { 459 lappend mlist [string range $m 2 end] 460 } 461 } 462 } 463 set blist [lsort -unique $mlist] 464 foreach m $blist { 465 element delete t_$m 466 element delete l1_$m 467 element delete l2_$m 468 element delete l3_$m 469 element delete l4_$m 470 } 471} 472 473#--------------------------------------------------------------------- 474# Key generation for annotating layouts. 475#--------------------------------------------------------------------- 476 477proc magic::genkey {layer {keysize 4}} { 478 global Opts 479 480 box size $keysize $keysize 481 paint $layer 482 if {[catch {set Opts(keys)}]} { 483 set Opts(keys) 0 484 } else { 485 incr Opts(keys) 486 } 487 # eval "element add rectangle keyrect$Opts(keys) subcircuit [box values]" 488 489 box move e $keysize 490 set bv [box values] 491 set cx [expr {([lindex $bv 2] + [lindex $bv 0]) / 2}] 492 set cy [expr {([lindex $bv 3] + [lindex $bv 1]) / 2}] 493 element add text key$Opts(keys) white $cx $cy $layer 494 element configure key$Opts(keys) flags east 495} 496 497#--------------------------------------------------------------------- 498# Because this file is read prior to setting the magic command 499# names in Tcl, we cannot run the magic commands here. Create 500# a procedure to enable the commands, then run that procedure 501# from the system .magic script. 502#--------------------------------------------------------------------- 503 504proc magic::enable_tools {} { 505 global Opts 506 507 # Set keystrokes for push and pop 508 magic::macro XK_greater {magic::pushstack [cellname list self]} 509 magic::macro XK_less {magic::popstack} 510 511 # Set keystrokes for the "tool" command. 512 magic::macro space {magic::tool} 513 magic::macro Shift_space {magic::tool box} 514 515 set Opts(tool) box 516 set Opts(motion) {} 517 set Opts(origin) {0 0} 518 set Opts(backupinterval) 60000 519 magic::crashbackups start 520} 521 522#--------------------------------------------------------------------- 523# routine which tracks wire generation 524#--------------------------------------------------------------------- 525 526proc magic::trackwire {window {option {}}} { 527 global Opts 528 529 if {$Opts(motion) == {}} { 530 if {$option == "done"} { 531 wire switch 532 } elseif {$option == "pick"} { 533 puts stdout $window 534 wire type 535 set Opts(motion) [bind ${window} <Motion>] 536 bind ${window} <Motion> [subst {$Opts(motion); *bypass wire show}] 537 if {$Opts(motion) == {}} {set Opts(motion) "null"} 538 cursor 21 539 } 540 } else { 541 if {$option != "cancel"} { 542 wire leg 543 } 544 if {$option == "done" || $option == "cancel"} { 545 select clear 546 if {$Opts(motion) == "null"} { 547 bind ${window} <Motion> {} 548 } else { 549 bind ${window} <Motion> "$Opts(motion)" 550 } 551 set Opts(motion) {} 552 cursor 19 553 } 554 } 555} 556 557#--------------------------------------------------------------------- 558# routine which tracks a selection pick 559#--------------------------------------------------------------------- 560 561proc magic::keepselect {window} { 562 global Opts 563 if {$Opts(motion) == {}} { 564 box move bl cursor 565 } else { 566 select keep 567 } 568} 569 570proc magic::startselect {window {option {}}} { 571 global Opts 572 if {$Opts(motion) == {}} { 573 if {$option == "pick"} { 574 select pick 575 } else { 576 set slist [what -list] 577 if {$slist == {{} {} {}}} { 578 select nocycle 579 } 580 } 581 set Opts(origin) [cursor] 582 set Opts(motion) [bind ${window} <Motion>] 583 bind ${window} <Motion> [subst {$Opts(motion); set p \[cursor\]; \ 584 set x \[expr {\[lindex \$p 0\] - [lindex $Opts(origin) 0]}\]i; \ 585 set y \[expr {\[lindex \$p 1\] - [lindex $Opts(origin) 1]}\]i; \ 586 *bypass select move \${x} \${y}}] 587 if {$Opts(motion) == {}} {set Opts(motion) "null"} 588 cursor 21 589 } else { 590 if {$Opts(motion) == "null"} { 591 bind ${window} <Motion> {} 592 } else { 593 bind ${window} <Motion> "$Opts(motion)" 594 } 595 copy center 0 596 set Opts(motion) {} 597 cursor 22 598 } 599} 600 601proc magic::cancelselect {window} { 602 global Opts 603 if {$Opts(motion) == {}} { 604 box corner ur cursor 605 } else { 606 if {$Opts(motion) == "null"} { 607 bind ${window} <Motion> {} 608 } else { 609 bind ${window} <Motion> "$Opts(motion)" 610 } 611 select clear 612 set Opts(motion) {} 613 cursor 22 614 } 615} 616 617#--------------------------------------------------------------------- 618# tool --- A scripted replacement for the "tool" 619# command, as handling of button events has been modified 620# to act like the handling of key events, so the "tool" 621# command just swaps macros for the buttons. 622# 623# Added By NP 10/27/2004 624#--------------------------------------------------------------------- 625 626proc magic::tool {{type next}} { 627 global Opts 628 629 # Don't attempt to switch tools while a selection drag is active 630 if {$Opts(motion) != {}} { 631 return 632 } 633 634 if {$type == "next"} { 635 switch $Opts(tool) { 636 box { set type wiring } 637 wiring { set type netlist } 638 netlist { set type pick } 639 pick { set type box } 640 } 641 } 642 switch $type { 643 info { 644 # print information about the current tool. 645 puts stdout "Current tool is $Opts(tool)." 646 puts stdout "Button command bindings:" 647 if {[llength [macro Button1]] > 0} { 648 macro Button1 649 } 650 if {[llength [macro Button2]] > 0} { 651 macro Button2 652 } 653 if {[llength [macro Button3]] > 0} { 654 macro Button3 655 } 656 if {[llength [macro Shift_Button1]] > 0} { 657 macro Shift_Button1 658 } 659 if {[llength [macro Shift_Button2]] > 0} { 660 macro Shift_Button2 661 } 662 if {[llength [macro Shift_Button3]] > 0} { 663 macro Shift_Button3 664 } 665 if {[llength [macro Control_Button1]] > 0} { 666 macro Control_Button1 667 } 668 if {[llength [macro Control_Button2]] > 0} { 669 macro Control_Button2 670 } 671 if {[llength [macro Control_Button3]] > 0} { 672 macro Control_Button3 673 } 674 } 675 box { 676 puts stdout {Switching to BOX tool.} 677 set Opts(tool) box 678 cursor 0 ;# sets the cursor 679 macro Button1 "box move bl cursor; magic::boxview %W %1" 680 macro Shift_Button1 "box corner bl cursor; magic::boxview %W %1" 681 macro Button2 "paint cursor" 682 macro Shift_Button2 "erase cursor" 683 macro Button3 "box corner ur cursor" 684 macro Shift_Button3 "box move ur cursor; magic::boxview %W %1" 685 macro Button4 "scroll u .05 w; magic::boxview %W %1" 686 macro Button5 "scroll d .05 w; magic::boxview %W %1" 687 macro Shift_XK_Pointer_Button4 "scroll r .05 w; magic::boxview %W %1" 688 macro Shift_XK_Pointer_Button5 "scroll l .05 w; magic::boxview %W %1" 689 690 } 691 wiring { 692 puts stdout {Switching to WIRING tool.} 693 set Opts(tool) wiring 694 cursor 19 ;# sets the cursor 695 macro Button1 "magic::trackwire %W pick" 696 macro Button2 "magic::trackwire %W done" 697 macro Button3 "magic::trackwire %W cancel" 698 macro Shift_Button1 "wire incr type ; wire show" 699 macro Shift_Button2 "wire switch" 700 macro Shift_Button3 "wire decr type ; wire show" 701 macro Button4 "wire incr width ; wire show" 702 macro Button5 "wire decr width ; wire show" 703 704 } 705 netlist { 706 puts stdout {Switching to NETLIST tool.} 707 set Opts(tool) netlist 708 cursor 18 ;# sets the cursor 709 macro Button1 "netlist select" 710 macro Button2 "netlist join" 711 macro Button3 "netlist terminal" 712 # Remove shift-button bindings 713 macro Shift_Button1 "" 714 macro Shift_Button2 "" 715 macro Shift_Button3 "" 716 macro Button4 "scroll u .05 w" 717 macro Button5 "scroll d .05 w" 718 } 719 pick { 720 puts stdout {Switching to PICK tool.} 721 set Opts(tool) pick 722 cursor 22 ;# set the cursor 723 macro Button1 "magic::keepselect %W" 724 macro Shift_Button2 "magic::startselect %W copy" 725 macro Button2 "magic::startselect %W pick" 726 macro Button3 "magic::cancelselect %W" 727 macro Shift_Button1 "box corner bl cursor" 728 macro Shift_Button3 "box move ur cursor" 729 macro Button4 "scroll u .05 w" 730 macro Button5 "scroll d .05 w" 731 } 732 } 733 734 # Update window captions with the new tool info 735 catch {magic::captions} 736 return 737} 738