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