Minsky
wiring.tcl
Go to the documentation of this file.
1 # @copyright Steve Keen 2012-2017
2 # @author Russell Standish
3 # This file is part of Minsky.
4 #
5 # Minsky is free software: you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation, either version 3 of the License, or
8 # (at your option) any later version.
9 #
10 # Minsky is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with Minsky. If not, see <http://www.gnu.org/licenses/>.
17 #
18 
19 frame .wiring.menubar
20 
21 # create icons for all operations
22 foreach op [availableOperations] {
23  if {$op=="numOps"} break
24  # ignore some operations
25  switch $op {
26  "constant" -
27  "copy" -
28  "ravel" -
29  "integrate" continue
30  }
31  image create photo [set op]Img -file $minskyHome/icons/$op.gif
32 }
33 
34 proc addToolTipToTearOff {text menu tornOffMenu} {
35  for {set i 1} {$i<=[$menu index last]} {incr i} {
36  tooltip $tornOffMenu -index $i [$menu entrycget $i -label]
37  }
38 }
39 
40 image create photo dataPng -file $minskyHome/icons/data.png
41 
42 set dataImportDialog 0
43 button .wiring.menubar.data -image dataPng \
44  -height 24 -width 37 -command {
45  minsky.addVariable dataImport parameter
46  itemFromItemFocus
47  set dataImportDialog 1
48  CSVImportDialog
49  }
50 tooltip .wiring.menubar.data "Import data"
51 pack .wiring.menubar.data -side left
52 set helpTopics(.wiring.menubar.data) "Operation:csvImport"
53 
54 image create photo ravelImg -file $minskyHome/icons/ravel.gif
55 button .wiring.menubar.ravel -image ravelImg \
56  -height 24 -width 37 -command {addRavel}
57 tooltip .wiring.menubar.ravel "Ravel"
58 pack .wiring.menubar.ravel -side left -padx {0 10}
59 set helpTopics(.wiring.menubar.ravel) "Ravel"
60 
61 image create photo plotImg -file $minskyHome/icons/plot.gif
62 button .wiring.menubar.plot -image plotImg \
63  -height 24 -width 37 -command {addPlot}
64 tooltip .wiring.menubar.plot "PlotWidget"
65 pack .wiring.menubar.plot -side left
66 set helpTopics(.wiring.menubar.plot) "PlotWidget"
67 
68 image create photo sheetImg -file $minskyHome/icons/sheet.gif
69 button .wiring.menubar.sheet -image sheetImg \
70  -height 24 -width 37 -command {addSheet}
71 tooltip .wiring.menubar.sheet "Sheet"
72 pack .wiring.menubar.sheet -side left
73 set helpTopics(.wiring.menubar.sheet) "Sheet"
74 
75 button .wiring.menubar.var -text var -foreground #9f0000 -command {
76  tk_popup .wiring.menubar.var.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
77 tooltip .wiring.menubar.var "Variable"
78 set helpTopics(.wiring.menubar.var) Variable
79 pack .wiring.menubar.var -side left
80 
81 menu .wiring.menubar.var.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "variable toolbar"}
82 .wiring.menubar.var.menu add command -label "variable" -command addVariable
83 .wiring.menubar.var.menu add command -label "constant" -command addConstant
84 .wiring.menubar.var.menu add command -label "parameter" -command addParameter
85 .wiring.menubar.var.menu add command -label "browser" -command variablePane
86 
87 image create photo lockImg -file $minskyHome/icons/lock.gif
88 button .wiring.menubar.lock -image lockImg \
89  -height 24 -width 37 -command {addLock}
90 tooltip .wiring.menubar.lock "Lock Ravel"
91 pack .wiring.menubar.lock -side left
92 set helpTopics(.wiring.menubar.lock) "Lock"
93 
94 image create photo noteImg -file $minskyHome/icons/note.gif
95 button .wiring.menubar.note -image noteImg \
96  -command {addNote "Enter your note here"}
97 tooltip .wiring.menubar.note "Note"
98 pack .wiring.menubar.note -side left
99 set helpTopics(.wiring.menubar.note) "Item"
100 
101 button .wiring.menubar.time -image timeImg -width 37 -height 24 -command {
102  addOperation time}
103 tooltip .wiring.menubar.time Time
104 set helpTopics(.wiring.menubar.time) Operation:time
105 
106 button .wiring.menubar.constops -image eulerImg -width 37 -height 24 -command {
107  tk_popup .wiring.menubar.constops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
108 tooltip .wiring.menubar.constops "Fundamental constants"
109 set helpTopics(.wiring.menubar.constops) Operations
110 menu .wiring.menubar.constops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "fundamental constants toolbox"}
111 
112 button .wiring.menubar.binops -image addImg -width 37 -height 24 -command {
113  tk_popup .wiring.menubar.binops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
114 tooltip .wiring.menubar.binops "Binary operations"
115 set helpTopics(.wiring.menubar.binops) Operations
116 menu .wiring.menubar.binops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "binary operations toolbox"}
117 
118 button .wiring.menubar.fnops -image sqrtImg -width 37 -height 24 -command {
119  tk_popup .wiring.menubar.fnops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
120 tooltip .wiring.menubar.fnops "Functions"
121 set helpTopics(.wiring.menubar.fnops) Operations
122 menu .wiring.menubar.fnops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "function toolbox"}
123 
124 button .wiring.menubar.reductionops -image sumImg -width 37 -height 24 -command {
125  tk_popup .wiring.menubar.reductionops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
126 tooltip .wiring.menubar.reductionops "Reductions"
127 set helpTopics(.wiring.menubar.reductionops) Operations
128 menu .wiring.menubar.reductionops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "reduction operations toolbox"}
129 
130 button .wiring.menubar.scanops -image runningSumImg -width 37 -height 24 -command {
131  tk_popup .wiring.menubar.scanops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
132 tooltip .wiring.menubar.scanops "Scans"
133 set helpTopics(.wiring.menubar.scanops) Operations
134 menu .wiring.menubar.scanops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "Scans toolbox"}
135 
136 button .wiring.menubar.tensorops -image outerProductImg -width 37 -height 24 -command {
137  tk_popup .wiring.menubar.tensorops.menu [winfo pointerx .wiring.canvas] [winfo pointery .wiring.canvas]}
138 tooltip .wiring.menubar.tensorops "Tensor operations"
139 set helpTopics(.wiring.menubar.tensorops) Operations
140 menu .wiring.menubar.tensorops.menu -tearoff 1 -tearoffcommand {addToolTipToTearOff "Tensor toolbox"}
141 
142 pack .wiring.menubar.time .wiring.menubar.constops .wiring.menubar.binops .wiring.menubar.fnops .wiring.menubar.reductionops -side left
143 pack .wiring.menubar.scanops .wiring.menubar.tensorops -side left
144 
145 proc addOpMenu {menu op} {
146  $menu add command -label $op -image [set op]Img -command "minsky.addOperation $op"
147  tooltip $menu -index [$menu index last] $op
148 }
149 
150 # create buttons for all available operations (aside from those
151 # handled especially)
152 foreach op [availableOperations] {
153  if {$op=="numOps"} break
154  # ignore some operations
155  switch $op {
156  "constant" -
157  "copy" -
158  "ravel" -
159  "integrate" -
160  "differentiate" -
161  "time" -
162  "userFunction" -
163  "data" continue
164  }
165 
166  switch [classifyOp $op] {
167  function {addOpMenu .wiring.menubar.fnops.menu $op}
168  constop {addOpMenu .wiring.menubar.constops.menu $op}
169  binop {addOpMenu .wiring.menubar.binops.menu $op}
170  reduction {addOpMenu .wiring.menubar.reductionops.menu $op}
171  "scan" {addOpMenu .wiring.menubar.scanops.menu $op}
172  tensor {addOpMenu .wiring.menubar.tensorops.menu $op}
173  default {
174  # shouldn't be here!
175  }
176  }
177 }
178 
179 tooltip .wiring.menubar.var.menu -index 0 "variable toolbar"
180 tooltip .wiring.menubar.constops.menu -index 0 "fundamental constants toolbox"
181 tooltip .wiring.menubar.binops.menu -index 0 "binary operations toolbox"
182 tooltip .wiring.menubar.fnops.menu -index 0 "function toolbar"
183 tooltip .wiring.menubar.reductionops.menu -index 0 "reduction operations toolbox"
184 tooltip .wiring.menubar.scanops.menu -index 0 "scans toolbox"
185 tooltip .wiring.menubar.tensorops.menu -index 0 "tensor toolbox"
186 
187 
188 image create photo switchImg -file $minskyHome/icons/switch.gif
189 button .wiring.menubar.switch -image switchImg \
190  -height 24 -width 37 -command {addSwitch}
191 tooltip .wiring.menubar.switch "Switch"
192 pack .wiring.menubar.switch -side left
193 set helpTopics(.wiring.menubar.switch) "SwitchIcon"
194 
195 button .wiring.menubar.userFunction -image userFunctionImg \
196  -height 24 -width 37 -command {addOperation userFunction}
197 tooltip .wiring.menubar.userFunction "User Defined Function"
198 pack .wiring.menubar.userFunction -side left -padx {0 10}
199 set helpTopics(.wiring.menubar.userFunction) "Operation:userFunction"
200 
201 
202 
203 image create photo godleyImg -file $minskyHome/icons/bank.gif
204 button .wiring.menubar.godley -image godleyImg -height 24 -width 37 \
205  -command addGodley
206 tooltip .wiring.menubar.godley "Godley table"
207 set helpTopics(.wiring.menubar.godley) GodleyIcon
208 
209 image create photo integrateImg -file $minskyHome/icons/integrate.gif
210 button .wiring.menubar.integrate -image integrateImg -width 37 -height 24 -command {
211  addOperation integrate}
212 tooltip .wiring.menubar.integrate Integrate
213 set helpTopics(.wiring.menubar.integrate) IntOp
214 
215 image create photo differentiateImg -file $minskyHome/icons/differentiate.gif
216 button .wiring.menubar.differentiate -image differentiateImg -width 37 -height 24 -command {
217  addOperation differentiate}
218 tooltip .wiring.menubar.differentiate Differentiate
219 set helpTopics(.wiring.menubar.differentiate) Operation:differentiate
220 
221 pack .wiring.menubar.godley .wiring.menubar.integrate .wiring.menubar.differentiate -side left -fill y
222 
223 pack .wiring.menubar -fill x
224 
225 # support tooltips
226 proc hoverMouse {} {
227  minsky.canvas.displayDelayedTooltip [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]
228 }
229 
230 # reset hoverMouse timer
231 proc wrapHoverMouse {op x y} {
232  after cancel hoverMouse
233  # ignore any exceptions
234  catch {minsky.canvas.$op $x $y}
235  after 3000 hoverMouse
236 }
237 
238 # On Macs, double-click binding is buggered, so bodgy up a simulated double-click
239 # This simulation is not as good as when tk does it properly, however.
240 if {[tk windowingsystem] == "aqua"} {
241  set buttonDownHandler ""
242  set buttonUpHandler ""
243  set doubleClickTimeout 200
244  bind .wiring.canvas <ButtonPress-1> {
245  if [catch {after info $buttonDownHandler}] {
246  set buttonDownHandler [after $doubleClickTimeout wrapHoverMouse mouseDown %x %y]
247  } else {
248  doubleButton %x %y
249  after cancel $buttonDownHandler
250  after cancel $buttonUpHandler
251  }
252  }
253  bind .wiring.canvas <ButtonRelease-1> {set buttonUpHandler [after $doubleClickTimeout wrapHoverMouse mouseUp %x %y]}
254 } else {
255  bind .wiring.canvas <ButtonPress-1> {wrapHoverMouse mouseDown %x %y}
256  bind .wiring.canvas <ButtonRelease-1> {wrapHoverMouse mouseUp %x %y]}
257  bind .wiring.canvas <Double-Button-1> {doubleButton %x %y}
258 }
259 
260 bind .wiring.canvas <$meta-ButtonPress-1> {wrapHoverMouse controlMouseDown %x %y}
261 bind .wiring.canvas <Motion> {wrapHoverMouse mouseMove %x %y}
262 bind .wiring.canvas <Leave> {after cancel hoverMouse}
263 
264 proc get_pointer_x {c} {
265  return [expr {[winfo pointerx $c] - [winfo rootx $c]}]
266  #return [winfo pointerx $c]
267 }
268 
269 proc get_pointer_y {c} {
270  return [expr {[winfo pointery $c] - [winfo rooty $c]}]
271  #return [winfo pointery $c]
272 }
273 
274 bind . <Key-KP_Add> {zoom 1.1}
275 bind . <Key-KP_Subtract> {zoom [expr 1.0/1.1]}
276 # mouse wheel bindings for X11
277 bind .wiring.canvas <Button-4> {zoomAt %x %y 1.1}
278 bind .wiring.canvas <Button-5> {zoomAt %x %y [expr 1.0/1.1]}
279 # mouse wheel bindings for pc and aqua
280 bind .wiring.canvas <MouseWheel> { if {%D>=0} {zoomAt %x %y 1.1} {zoomAt %x %y [expr 1.0/(1.1)]} }
281 
282 if {[tk windowingsystem]!="aqua"} {
283  bind .wiring.canvas <Alt-Button-1> {
284  tk_messageBox -message "Mouse coordinates %x %y"
285  }
286 }
287 
288 proc zoom {factor} {
289  set cbounds [minsky.model.cBounds]
290  set x0 [expr 0.5*([lindex $cbounds 0]+[lindex $cbounds 2])]
291  set y0 [expr 0.5*([lindex $cbounds 1]+[lindex $cbounds 3])]
292  zoomAt $x0 $y0 $factor
293 }
294 
295 proc zoomAt {x0 y0 factor} {
296  global preferences
297  canvas.model.zoom $x0 $y0 $factor
298  canvas.requestRedraw
299  if $preferences(panopticon) panopticon.requestRedraw
300 }
301 
302 .menubar.ops add command -label "Godley Table" -command canvas.addGodley
303 
304 .menubar.ops add cascade -label "Variable" -menu .wiring.menubar.var.menu
305 .menubar.ops add cascade -label "Fundamental constants" -menu .menubar.ops.constops
306 .menubar.ops add cascade -label "Binary Ops" -menu .menubar.ops.binops
307 .menubar.ops add cascade -label "Functions" -menu .menubar.ops.functions
308 .menubar.ops add cascade -label "Reductions" -menu .menubar.ops.reductions
309 .menubar.ops add cascade -label "Scans" -menu .menubar.ops.scans
310 .menubar.ops add cascade -label "Tensor operations" -menu .menubar.ops.tensors
311 
312 menu .menubar.ops.constops
313 menu .menubar.ops.binops
314 menu .menubar.ops.functions
315 menu .menubar.ops.reductions
316 menu .menubar.ops.scans
317 menu .menubar.ops.tensors
318 
319 foreach op [availableOperations] {
320  if {$op=="constant"} continue
321  if {$op=="numOps"} break
322  set label [regsub {(.*)_$} $op {\1}]
323  switch $op {
324  "ravel" -
325  "integrate" -
326  "differentiate" -
327  "time" -
328  "data" {.menubar.ops add command -label $label -command "minsky.addOperation $op"}
329  default {
330  switch [classifyOp $op] {
331  function {.menubar.ops.functions add command -label $label -command "minsky.addOperation $op"}
332  constop {.menubar.ops.constops add command -label $label -command "minsky.addOperation $op"}
333  binop {.menubar.ops.binops add command -label $label -command "minsky.addOperation $op"}
334  reduction {.menubar.ops.reductions add command -label $label -command "minsky.addOperation $op"}
335  "scan" {.menubar.ops.scans add command -label $label -command "minsky.addOperation $op"}
336  tensor {.menubar.ops.tensors add command -label $label -command "minsky.addOperation $op"}
337  }
338  }
339  }
340 }
341 
342 # default command to execute when escape key is pressed
343 proc handleEscapeKey {} {
344  .wiring.context unpost
345 }
346 bind . <Key-Escape> {handleEscapeKey}
347 
348 proc addVariablePostModal {} {
349  global globals
350  global varInput
351  global varType
352 
353  set name [string trim $varInput(Name)]
354  set varExists [variableValues.count $name]
355  minsky.addVariable $name $varInput(Type)
356  canvas.itemFocus.init $varInput(Value)
357  canvas.itemFocus.setUnits $varInput(Units)
358  if {!$varExists} {
359  getValue [canvas.itemFocus.valueId]
360  canvas.itemFocus.rotation [set varInput(Rotation)]
361 # canvas.itemFocus.tooltip [set "varInput(Short description)"]
362 # canvas.itemFocus.detailedText [set "varInput(Detailed description)"]
363  canvas.itemFocus.sliderMax [set "varInput(Slider Bounds: Max)"]
364  canvas.itemFocus.sliderMin [set "varInput(Slider Bounds: Min)"]
365  canvas.itemFocus.sliderStep [set "varInput(Slider Step Size)"]
366  canvas.itemFocus.sliderBoundsSet 1
367  }
368  closeEditWindow .wiring.initVar
369 }
370 
371 
372 proc addVariable {} {
373  global varInput varType initVar_name
374  set varType flow
375  set varInput(title) "Create Variable"
376  addConstantOrVariable
377  .wiring.initVar.$initVar_name configure -state normal
378 }
379 
380 
381 proc addConstant {} {
382  global varInput varType initVar_name
383  set varType constant
384  set varInput(title) "Create Constant"
385  addConstantOrVariable
386  .wiring.initVar.$initVar_name configure -state disabled
387 }
388 
389 proc addParameter {} {
390  global varInput varType initVar_name
391  set varType parameter
392  set varInput(title) "Create Parameter"
393  addConstantOrVariable
394  .wiring.initVar.$initVar_name configure -state normal
395 }
396 
397 proc addConstantOrVariable {} {
398  global varInput varType
399  set varInput(Name) ""
400  set varInput(Value) ""
401  set varInput(Units) ""
402  set varInput(Rotation) [minsky.canvas.defaultRotation]
403  set varInput(Type) $varType
404  set "varInput(Short description)" ""
405  set "varInput(Detailed description)" ""
406  deiconifyInitVar
407  resetItem
408  garbageCollect
409  .wiring.initVar.entry10 configure -values [minsky.canvas.model.accessibleVars]
410  ::tk::TabToWindow $varInput(initial_focus);
411  ensureWindowVisible .wiring.initVar
412  grab set .wiring.initVar
413  wm transient .wiring.initVar
414 }
415 
416 
417 # add operation from a keypress
418 proc addOperationKey {op} {
419  addOperation $op
420  canvas.mouseUp [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]
421 }
422 
423 proc addPlotKey {} {
424  addPlot
425  canvas.mouseUp [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]
426 }
427 
428 proc addNewGodleyItemKey {} {
429  addGodley
430  canvas.mouseUp [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]
431 }
432 
433 # handle arbitrary text typed into the canvas
434 proc textInput {char} {
435  if {$char==""} return
436 
437  global textBuffer globals
438  #ignore anything unprintable!
439  set x [get_pointer_x .wiring.canvas]
440  set y [get_pointer_y .wiring.canvas]
441 
442  set textBuffer "$char"
443  textEntryPopup .textInput $char textOK
444  .textInput.entry configure -textvariable textBuffer -takefocus 1
445  wm geometry .textInput "+[winfo pointerx .]+[winfo pointery .]"
446 }
447 
448 # executed whenever the OK button of textInput is invoked
449 proc textOK {} {
450  global textBuffer
451  grab release .textInput
452  destroy .textInput
453  canvas.moveOffsX 0
454  canvas.moveOffsY 0
455  if {[lsearch [availableOperations] $textBuffer]>-1} {
456  set subTextBuffer [string range $textBuffer 1 end]
457  if {[lsearch [availableOperations] $subTextBuffer]>-1} { # ensure that names escaped with \ can be used as ops or pars and vars as the case may be. for ticket 1291
458  addOperationKey $subTextBuffer
459  } else {
460  addOperationKey $textBuffer
461  }
462  } elseif {[llength $textBuffer]==1 && [string match "-" $textBuffer]} { # minus sign only creates subtract op. for ticket 145
463  addOperationKey subtract
464  } elseif [string match "\[%#\]*" $textBuffer] {
465  addNote [string range $textBuffer 1 end]
466  } else {
467  if [regexp "(.*)=(.*)" $textBuffer dummy name init] {
468  minsky.addVariable $name flow
469  minsky.canvas.itemFocus.init $init
470  minsky.variableValues.reset
471  # signed numbers create constant on the canvas. for ticket 145.
472  } else {
473  if [regexp "^\[+-\]?\\d*\\.?\\d+\[eE\]?\[+-\]?\\d*$" $textBuffer] {
474 
475  minsky.addVariable $textBuffer constant
476  minsky.canvas.itemFocus.init $textBuffer
477  minsky.variableValues.reset
478  } else {
479  minsky.addVariable $textBuffer flow
480  }
481 
482  getItemAtFocus
483  editVar
484  }
485  }
486  canvas.mouseUp [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]
487 }
488 
489 proc canvasKeyPress {N A s} {
490  return [canvas.keyPress $N [encoding convertto utf-8 $A] $s \
491  [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]]
492 }
493 
494 
495 # operation add shortcuts
496 bind . <Key-plus> {if {![canvasKeyPress %N %A %s]} {addOperationKey add}}
497 bind . <Key-minus> {if {![canvasKeyPress %N %A %s]} {textInput "-"; .wiring.canvas configure -cursor {}}}
498 bind . <Key-asterisk> {if {![canvasKeyPress %N %A %s]} {addOperationKey multiply}}
499 bind . <Key-KP_Multiply> {if {![canvasKeyPress %N %A %s]} {addOperationKey multiply}}
500 bind . <Key-slash> {if {![canvasKeyPress %N %A %s]} {addOperationKey divide}}
501 bind . <Key-KP_Divide> {if {![canvasKeyPress %N %A %s]} {addOperationKey divide}}
502 bind . <Key-asciicircum> {if {![canvasKeyPress %N %A %s]} {addOperationKey pow}}
503 #bind . <Key-backslash> {if {![canvasKeyPress %N %A]} {addOperationKey sqrt}}
504 bind . <Key-ampersand> {if {![canvasKeyPress %N %A %s]} {addOperationKey integrate}}
505 bind . <Key-equal> {if {![canvasKeyPress %N %A %s]} {addNewGodleyItemKey}}
506 bind . <Key-at> {if {![canvasKeyPress %N %A %s]} {addPlotKey}}
507 
508 array set modifiers {"Control_L" "1" "Control_R" "1" "Alt_L" "1" "Alt_R" "1"}
509 
510 #Clear canvas pan mode in case shift key is pressed to create a capitalized variable via textInput. for ticket 1112.
511 bind . <Key> {
512  # ignore any modifier keys
513  if {![info exists modifiers(%K)]} {
514  if {![canvasKeyPress %N %A %s]} {
515  textInput %A
516  .wiring.canvas configure -cursor {}
517  }
518  }
519 }
520 
521 bind . <Key-Delete> {if {![canvasKeyPress %N %A %s]} {deleteKey [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]}}
522 bind . <Key-BackSpace> {if {![canvasKeyPress %N %A %s]} {deleteKey [get_pointer_x .wiring.canvas] [get_pointer_y .wiring.canvas]}}
523 
524 bind . <KeyPress-Shift_L> {.wiring.canvas configure -cursor $panIcon}
525 bind . <KeyRelease-Shift_L> {.wiring.canvas configure -cursor {}}
526 bind . <KeyPress-Shift_R> {.wiring.canvas configure -cursor $panIcon}
527 bind . <KeyRelease-Shift_R> {.wiring.canvas configure -cursor {}}
528 
529 # handle processing when delete or backspace is pressed
530 proc deleteKey {x y} {
531  if {![canvas.selection.empty]} {
532  cut
533  } elseif [getItemAt $x $y] {
534  canvas.deleteItem
535  } elseif [getWireAt $x $y] {
536  canvas.deleteWire
537  }
538 }
539 
540 # global godley icon resource
541 setGodleyIconResource $minskyHome/icons/bank.svg
542 setLockIconResource $minskyHome/icons/Antu_emblem-locked.svg $minskyHome/icons/Antu_emblem-unlocked.svg
543 setRavelIconResource $minskyHome/icons/ravel-logo.svg
544 
545 proc rightMouseGodley {x y X Y} {
546  if [selectVar $x $y] {
547  .wiring.context delete 0 end
548  .wiring.context add command -label "Copy" -command canvas.copyItem
549  .wiring.context add command -label "Rename all instances" -command renameVariableInstances
550  .wiring.context post $X $Y
551  } else {
552  contextMenu $x $y $X $Y
553  }
554 }
555 # pan mode
556 bind .wiring.canvas <Shift-Button-1> {
557  set panOffsX [expr %x-[minsky.canvas.model.x]]
558  set panOffsY [expr %y-[minsky.canvas.model.y]]
559 }
560 bind .wiring.canvas <Shift-B1-Motion> {panCanvas [expr %x-$panOffsX] [expr %y-$panOffsY]}
561 
562 menu .wiring.context -tearoff 0
563 
564 proc bookmarkAt {x y X Y} {
565  # centre x,y in the visible canvas
566  set delx [expr 0.5*[.wiring.canvas cget -width]-$x + [minsky.canvas.model.x]]
567  set dely [expr 0.5*[.wiring.canvas cget -height]-$y+[minsky.canvas.model.y]]
568  minsky.canvas.model.moveTo $delx $dely
569 
570  toplevel .getBookmarkName
571  wm title .getBookmarkName "Enter bookmark label"
572  entry .getBookmarkName.text -width 30
573  pack .getBookmarkName.text
574  buttonBar .getBookmarkName {
575  minsky.canvas.model.addBookmark [.getBookmarkName.text get]
576  }
577  grab set .getBookmarkName
578  wm transient .getBookmarkName
579  wm geometry .getBookmarkName +$X+$Y
580 }
581 
582 # context menu on background canvas
583 proc canvasContext {x y X Y} {
584  .wiring.context delete 0 end
585  .wiring.context add command -label Help -command {help DesignCanvas}
586  .wiring.context add command -label "Cut" -command cut
587  .wiring.context add command -label "Copy selection" -command "minsky.copy"
588  .wiring.context add command -label "Save selection as" -command saveSelection
589  .wiring.context add command -label "Paste selection" -command pasteAt
590  if {[getClipboard]==""} {
591  .wiring.context entryconfigure end -state disabled
592  }
593  .wiring.context add command -label "Hide defining groups of selected variables" -command "minsky.canvas.pushDefiningVarsToTab"
594  .wiring.context add command -label "Show all defining groups on canvas" -command "minsky.canvas.showDefiningVarsOnCanvas"
595  .wiring.context add command -label "Show all plots on tab" -command "minsky.canvas.showPlotsOnTab"
596  .wiring.context add command -label "Bookmark here" -command "bookmarkAt $x $y $X $Y"
597  .wiring.context add command -label "Group" -command "minsky.createGroup"
598  .wiring.context add command -label "Lock selected Ravels" -command "minsky.canvas.lockRavelsInSelection"
599  .wiring.context add command -label "Unlock selected Ravels" -command "minsky.canvas.unlockRavelsInSelection"
600  .wiring.context add command -label "Open master group" -command "openModelInCanvas"
601  tk_popup .wiring.context $X $Y
602 }
603 
604 proc saveSelection {} {
605  global workDir
606  set ext [canvas.selection.defaultExtension]
607  set f [tk_getSaveFile -defaultextension $ext -initialdir $workDir \
608  -filetypes [fileTypes $ext]]
609  if [string length $f] {
610  set workDir [file dirname $f]
611  eval minsky.saveSelectionAsFile {$f}
612  }
613 }
614 
615 
616 proc doubleButton {x y} {
617  if [getItemAt $x $y] {
618  if {[canvas.item.classType]=="Lock"} {
619  canvas.item.toggleLocked
620  reset
621  } else {
622  selectVar $x $y
623  editItem
624  }
625  } else {
626  # For ticket 1092. Reinstate delete handle user interaction
627  canvas.delHandle $x $y
628  }
629 }
630 # for ticket 1062, new hierarchy of context menu access on mouse right click: wires, items and background canvas.
631 bind .wiring.canvas <<contextMenu>> {
632  if {[getWireAt %x %y] && [minsky.canvas.wire.visible]} { # prevents wire context menu from being accessed when group contents are not transparent. for ticket 1225.
633  wireContextMenu %X %Y
634  } elseif [getItemAt %x %y] {
635  switch [minsky.canvas.item.classType] {
636  GodleyIcon {rightMouseGodley %x %y %X %Y}
637  Group {rightMouseGroup %x %y %X %Y}
638  default {contextMenu %x %y %X %Y}
639  }
640  } else {
641  canvasContext %x %y %X %Y
642  }
643 }
644 
645 # proc raiseItem {item} {
646 # .wiring.canvas raise $item all
647 # }
648 # proc lowerItem {item} {
649 # .wiring.canvas lower $item all
650 # }
651 #
652 proc wireContextMenu {x y} {
653  .wiring.context delete 0 end
654  .wiring.context add command -label Help -command {help Wires}
655  .wiring.context add command -label Description -command "postNote wire"
656  .wiring.context add command -label "Straighten" -command "minsky.canvas.wire.straighten"
657 # .wiring.context add command -label "Raise" -command "raiseItem wire$id"
658 # .wiring.context add command -label "Lower" -command "lowerItem wire$id"
659  .wiring.context add command -label "Browse object" -command "obj_browser minsky.canvas.wire.*"
660  .wiring.context add command -label "Delete wire" -command "canvas.deleteWire"
661  tk_popup .wiring.context $x $y
662 }
663 
664 proc renameVariableInstances {} {
665  textEntryPopup .renameDialog [minsky.canvas.item.name] {
666  canvas.renameAllInstances [.renameDialog.entry get]
667  canvas.requestRedraw
668  }
669  wm title .renameDialog "Rename [minsky.canvas.item.name]"
670 }
671 
672 proc renameIntegralInstances {} {
673  textEntryPopup .renameDialog [minsky.canvas.item.description] {
674  canvas.renameAllInstances [.renameDialog.entry get]
675  canvas.requestRedraw
676  }
677  wm title .renameDialog "Rename [minsky.canvas.item.description]"
678 }
679 
680 proc findDefinition {} {
681  set cwidth [.wiring.canvas cget -width]
682  set cheight [.wiring.canvas cget -height]
683  if [findVariableDefinition] {
684  if {abs([minsky.canvas.item.x]-0.5*$cwidth)>0.5*$cwidth ||
685  abs([minsky.canvas.item.y]-0.5*$cheight)>0.5*$cheight} {
686  # recentre found item
687  set offsX [expr [minsky.canvas.model.x]-[minsky.canvas.item.x]+0.5*$cwidth]
688  set offsY [expr [minsky.canvas.model.y]-[minsky.canvas.item.y]+0.5*$cheight]
689  panCanvas $offsX $offsY
690  }
691  canvas.itemIndicator 1
692  } else {
693  tk_messageBox -message "Definition not found"
694  }
695 }
696 
697 # increment switch cases by delta
698 proc incrCase {delta} {
699  set item minsky.canvas.item
700  $item.setNumCases [expr [$item.numCases]+$delta]
701  canvas.requestRedraw
702 }
703 
704 proc gotoInstance {vid} {
705  global .instanceList$vid.variableList
706  [set .instanceList$vid.variableList].gotoInstance [.instanceList$vid.listbox curselection]
707  canvas.requestRedraw
708 }
709 
710 proc deleteInstance vid {
711  global .instanceList$vid.variableList
712  if [llength [info commands [set .instanceList$vid.variableList].delete]] {
713  [set .instanceList$vid.variableList].delete
714  }
715 }
716 
717 proc findAllInstances {} {
718  # check if variable selected
719  if {![llength [info commands minsky.canvas.item.valueId]]} return
720  set vid [minsky.canvas.item.valueId]
721  if {![winfo exists .instanceList[minsky.canvas.item.valueId]]} {
722  toplevel .instanceList$vid
723  listbox .instanceList$vid.listbox -listvariable .instanceList$vid.listIds -selectmode single
724  button .instanceList$vid.ok -text "OK" -command "destroy .instanceList$vid"
725  pack .instanceList$vid.listbox .instanceList$vid.ok
726  bind .instanceList$vid.listbox <Double-Button> "gotoInstance $vid"
727  }
728  global .instanceList$vid.listIds .instanceList$vid.variableList
729  set .instanceList$vid.variableList [listAllInstances]
730  set .instanceList$vid.listIds [[set .instanceList$vid.variableList].names]
731  bind .instanceList$vid <Destroy> "deleteInstance $vid"
732  raise .instanceList$vid
733 }
734 
735 #
736 # context menu
737 proc contextMenu {x y X Y} {
738  set item minsky.canvas.item
739  .wiring.context delete 0 end
740  .wiring.context add command -label Help -command "help [$item.classType]"
741  .wiring.context add command -label Description -command "postNote item"
742  # find out what type of item we're referring to
743  switch -regex [$item.classType] {
744  "Variable*|VarConstant" {
745  catch {
746  if {[llength [minsky.canvas.item.dims]]==0} {
747  .wiring.context add command -label "Value [minsky.canvas.item.value]"
748  } else {
749  .wiring.context add command -label "Dims [minsky.canvas.item.dims]"
750  }
751  }
752  .wiring.context add command -label "Find definition" -command "findDefinition"
753  .wiring.context add command -label "Select all instances" -command {
754  canvas.selectAllVariables
755  }
756  .wiring.context add command -label "Find all instances" -command {
757  findAllInstances
758  }
759  .wiring.context add command -label "Rename all instances" -command {
760  renameVariableInstances
761  }
762  .wiring.context add command -label "Edit" -command "editItem"
763  .wiring.context add command -label "Copy item" -command "canvas.copyItem"
764  if {![inputWired [$item.valueId]]} {
765  .wiring.context add command -label "Add integral" -command "addIntegral"
766  }
767  .wiring.context add command -label "Flip" -command "$item.flip; flip_default"
768  if {[$item.type]=="parameter"} {
769  .wiring.context add command -label "Import CSV" -command {CSVImportDialog}
770  .wiring.context add command -label "Display CSV values on tab" -command {setupPickDimMenu}
771  }
772  .wiring.context add command -label "Export as CSV" -command exportItemAsCSV
773  }
774  "Operation*|IntOp|DataOp|UserFunction" {
775  set portValues "unknown"
776  catch {set portValues [$item.portValues]}
777  .wiring.context add command -label "Port values $portValues"
778  .wiring.context add command -label "Edit" -command "editItem"
779  if {[$item.type]=="data"} {
780  .wiring.context add command -label "Import Data" \
781  -command "importData"
782  .wiring.context add command -label "Initialise Random" \
783  -command "initRandom"
784  }
785  .wiring.context add command -label "Copy item" -command "canvas.copyItem"
786  .wiring.context add command -label "Flip" -command "$item.flip; flip_default"
787  if {[$item.type]=="integrate"} {
788  .wiring.context add command -label "Toggle var binding" -command "minsky.canvas.item.toggleCoupled; canvas.requestRedraw"
789  .wiring.context add command -label "Select all instances" -command {
790  canvas.selectAllVariables
791  }
792  .wiring.context add command -label "Rename all instances" -command {
793  renameIntegralInstances
794  }
795  }
796  }
797  "PlotWidget" {
798  .wiring.context add command -label "Expand" -command "plotDoubleClick [TCLItem]"
799  .wiring.context add command -label "Make Group Plot" -command "$item.makeDisplayPlot"
800  .wiring.context add command -label "Options" -command "doPlotOptions $item"
801  .wiring.context add command -label "Pen Styles" -command "penStyles $item"
802  .wiring.context add command -label "Export as CSV" -command exportItemAsCSV
803  .wiring.context add command -label "Export resolution factor: [$item.resolutionScaleFactor]" -command "setExportResolutionFactor $item"
804 
805  .wiring.context add command -label "Export as Image" -command exportItemAsImg
806  }
807  "GodleyIcon" {
808  .wiring.context add command -label "Open Godley Table" -command "openGodley [minsky.openGodley]"
809  .wiring.context add command -label "Title" -command {
810  textEntryPopup .editGodleyTitle [minsky.canvas.item.table.title] {minsky.canvas.item.table.title [.editGodleyTitle.entry get]; canvas.requestRedraw}
811  }
812  .wiring.context add command -label "Set currency" -command {
813  textEntryPopup .godleyCurrency {} {minsky.canvas.item.setCurrency [.godleyCurrency.entry get]}
814  }
815  global editorMode buttonDisplay variableDisplay
816  set editorMode [$item.editorMode]
817  set buttonDisplay [$item.buttonDisplay]
818  set variableDisplay [$item.variableDisplay]
819  .wiring.context add checkbutton -label "Editor mode" -command "$item.toggleEditorMode" -variable editorMode
820  .wiring.context add checkbutton -label "Row/Col buttons" -command "$item.toggleButtons" -variable buttonDisplay
821  .wiring.context add checkbutton -label "Display variables" -command "$item.toggleVariableDisplay" -variable variableDisplay
822  .wiring.context add command -label "Copy flow variables" -command "canvas.copyAllFlowVars"
823  .wiring.context add command -label "Copy stock variables" -command "canvas.copyAllStockVars"
824  .wiring.context add command -label "Export to file" -command "godley::export"
825  }
826  "Group" {
827  .wiring.context add command -label "Edit" -command "groupEdit"
828  .wiring.context add command -label "Open in canvas" -command "openGroupInCanvas"
829  .wiring.context add command -label "Zoom to display" -command "canvas.zoomToDisplay"
830  .wiring.context add command -label "Remove plot icon" -command "$item.removeDisplayPlot"
831  .wiring.context add command -label "Copy" -command "canvas.copyItem"
832  .wiring.context add command -label "Make subroutine" -command "$item.makeSubroutine"
833  .wiring.context add command -label "Save group as" -command "group::save"
834  .wiring.context add command -label "Flip" -command "$item.flip; flip_default"
835  .wiring.context add command -label "Flip Contents" -command "$item.flipContents; canvas.requestRedraw"
836  .wiring.context add command -label "Ungroup" -command "canvas.ungroupItem; canvas.requestRedraw"
837  }
838  "Item" {
839  .wiring.context add command -label "Copy item" -command "canvas.copyItem"
840  }
841  SwitchIcon {
842  .wiring.context add command -label "Add case" -command "incrCase 1"
843  .wiring.context add command -label "Delete case" -command "incrCase -1"
844  .wiring.context add command -label "Flip" -command "$item.flipped [expr ![minsky.canvas.item.flipped]]; canvas.requestRedraw"
845  }
846  Ravel {ravelContextItems}
847  Lock {
848  if [$item.locked] {
849  .wiring.context add command -label "Unlock" -command $item.toggleLocked
850  } else {
851  .wiring.context add command -label "Lock" -command $item.toggleLocked
852  }
853  }
854  }
855 
856  # common trailer
857 # .wiring.context add command -label "Raise" -command "raiseItem $tag"
858 # .wiring.context add command -label "Lower" -command "lowerItem $tag"
859  .wiring.context add command -label "Browse object" -command "obj_browser minsky.canvas.item.*"
860  .wiring.context add command -label "Delete [minsky.canvas.item.classType]" -command "canvas.deleteItem"
861  tk_popup .wiring.context $X $Y
862 }
863 
864 proc exportItemAsCSV {} {
865  global workDir
866  set f [tk_getSaveFile -defaultextension .csv -filetypes {
867  {"CSV" .csv TEXT} {"All" {.*} TEXT}
868  } -initialdir $workDir]
869  if {$f!=""} {
870  set workDir [file dirname $f]
871  eval minsky.canvas.item.exportAsCSV {$f}
872  }
873 }
874 
875 proc exportItemAsImg {} {
876  global workDir type
877  set f [tk_getSaveFile -filetypes [imageFileTypes] -initialdir $workDir -typevariable type]
878  if {$f==""} return
879  set workDir [file dirname $f]
880  renderImage $f $type minsky.canvas.item
881 }
882 
883 namespace eval godley {
884  proc export {} {
885  global workDir type
886  set item minsky.canvas.item
887 
888  set fname [tk_getSaveFile -filetypes {{"CSV files" .csv TEXT} {"LaTeX files" .tex TEXT}} \
889  -initialdir $workDir -typevariable type]
890  if {$fname==""} return
891  set workDir [file dirname $fname]
892  if [string match -nocase *.csv "$fname"] {
893  eval $item.table.exportToCSV {$fname}
894  } elseif [string match -nocase *.tex "$fname"] {
895  eval $item.table.exportToLaTeX {$fname}
896  } else {
897  switch $type {
898  "CSV files" {eval $item.table.exportToCSV {$fname.csv}}
899  "LaTeX files" {eval $item.table.exportToLaTeX {$fname.tex}}
900  }
901  }
902  }
903 }
904 
905 proc flip_default {} {
906  minsky.canvas.defaultRotation [expr ([minsky.canvas.defaultRotation]+180)%360]
907 }
908 
909 proc deiconifyEditVar {} {
910  if {![winfo exists .wiring.editVar]} {
911  toplevel .wiring.editVar
912  wm resizable .wiring.editVar 0 0
913  wm title .wiring.editVar "Edit Variable"
914  wm transient .wiring.editVar .wiring
915 
916  set row 0
917  grid [label .wiring.editVar.title -textvariable editVarInput(title)] -row $row -column 0 -columnspan 999 -pady 10
918 
919  global rowdict
920  global editVarInput
921  set rowdict(Name) 10
922  grid [label .wiring.editVar.label10 -text "Name"] -row 10 -column 10 -sticky e
923  grid [ttk::combobox .wiring.editVar.entry10 -textvariable editVarInput(Name)] -row 10 -column 20 -sticky ew -columnspan 2
924 
925  set rowdict(Type) 20
926  grid [label .wiring.editVar.label20 -text "Type"] -row 20 -column 10 -sticky e
927  grid [ttk::combobox .wiring.editVar.entry20 -textvariable editVarInput(Type) \
928  -state readonly -values "constant parameter flow integral stock"] \
929  -row 20 -column 20 -sticky ew -columnspan 2
930 
931 
932 
933  set row 30
934  foreach var {
935  "Initial Value"
936  "Units"
937  "Rotation"
938  "Short description"
939  "Detailed description"
940  "Slider Bounds: Max"
941  "Slider Bounds: Min"
942  "Slider Step Size"
943  } {
944  set rowdict($var) $row
945  grid [label .wiring.editVar.label$row -text $var] -row $row -column 10 -sticky e
946  grid [entry .wiring.editVar.entry$row -textvariable editVarInput($var)] -row $row -column 20 -sticky ew -columnspan 2
947  incr row 10
948  }
949  set editVarInput(initial_focus_value) ".wiring.editVar.entry$rowdict(Initial Value)"
950  set editVarInput(units_focus_value) ".wiring.editVar.entry$rowdict(Units)"
951  set editVarInput(initial_focus_rotation) .wiring.editVar.entry$rowdict(Rotation)
952 
953  # disable or enable the name field depending on type being selected
954  # constants cannot edit name, and neither constant nor flows allow units to be edited
955  bind .wiring.editVar.entry20 <<ComboboxSelected>> {
956  switch [.wiring.editVar.entry20 get] {
957  "constant" {
958  .wiring.editVar.entry10 configure -state disabled
959  #units
960  .wiring.editVar.entry40 configure -state disabled
961  }
962  "flow" {
963  .wiring.editVar.entry10 configure -state normal
964  .wiring.editVar.entry40 configure -state disabled
965  }
966  default {
967  .wiring.editVar.entry10 configure -state normal
968  .wiring.editVar.entry40 configure -state normal
969  }
970  }
971  }
972 
973  # initialise variable type when selected from combobox
974  bind .wiring.editVar.entry10 <<ComboboxSelected>> {
975  getValue [minsky.canvas.item.valueIdInCurrentScope [.wiring.editVar.entry10 get]]
976  .wiring.editVar.entry20 set [value.type]
977  }
978 
979  frame .wiring.editVar.buttonBar
980  button .wiring.editVar.buttonBar.ok -text OK -command {
981  set item minsky.canvas.item
982  $item.init $editVarInput(Initial Value)
983  $item.setUnits $editVarInput(Units)
984  $item.rotation $editVarInput(Rotation)
985 # $item.tooltip $editVarInput(Short description)
986 # $item.detailedText $editVarInput(Detailed description)
987  $item.sliderMax $editVarInput(Slider Bounds: Max)
988  $item.sliderMin $editVarInput(Slider Bounds: Min)
989  $item.sliderStep $editVarInput(Slider Step Size)
990  $item.sliderStepRel $editVarInput(relative)
991  retypeItem $editVarInput(Type)
992  canvas.renameItem $editVarInput(Name)
993 
994  makeVariablesConsistent
995  catch reset
996  closeEditWindow .wiring.editVar
997  }
998  # adjust "Slider Step Size" row to include "relative" radiobutton
999  set row "$rowdict(Slider Step Size)"
1000  grid configure .wiring.editVar.entry$row -columnspan 1
1001  grid [checkbutton .wiring.editVar.checkbox$row -text "relative" -variable "editVarInput(relative)"] -row $row -column 21 -sticky ew -columnspan 1
1002 
1003  button .wiring.editVar.buttonBar.cancel -text Cancel -command {
1004  closeEditWindow .wiring.editVar}
1005  pack .wiring.editVar.buttonBar.ok -side left -pady 10
1006  if {[minsky.canvas.item.type]=="parameter"} {
1007  button .wiring.editVar.buttonBar.import -text "Import CSV" -command {
1008  .wiring.editVar.buttonBar.ok invoke
1009  CSVImportDialog
1010  }
1011  pack .wiring.editVar.buttonBar.import -side left -pady 10
1012  }
1013 
1014  pack [label .wiring.editVar.buttonBar.spacer -width 2] .wiring.editVar.buttonBar.cancel -side left -pady 10
1015  grid .wiring.editVar.buttonBar -row 999 -column 0 -columnspan 1000
1016  bind .wiring.editVar <Key-Return> {invokeOKorCancel .wiring.editVar.buttonBar}
1017  bind .wiring.editVar <Key-Escape> {.wiring.editVar.buttonBar.cancel invoke}
1018  } else {
1019  wm deiconify .wiring.editVar
1020  }
1021 }
1022 
1023 proc deiconifyInitVar {} {
1024  if {![winfo exists .wiring.initVar]} {
1025  toplevel .wiring.initVar
1026  wm resizable .wiring.initVar 0 0
1027  wm title .wiring.initVar "Specify variable name"
1028  wm transient .wiring.initVar .wiring
1029 
1030  set row 0
1031  grid [label .wiring.initVar.title -textvariable varInput(title)] -row $row -column 0 -columnspan 999 -pady 10
1032  frame .wiring.initVar.buttonBar
1033  button .wiring.initVar.buttonBar.ok -text OK -command "addVariablePostModal"
1034  button .wiring.initVar.buttonBar.cancel -text Cancel -command {
1035  closeEditWindow .wiring.initVar}
1036  pack .wiring.initVar.buttonBar.ok [label .wiring.initVar.buttonBar.spacer -width 2] .wiring.initVar.buttonBar.cancel -side left -pady 10
1037  grid .wiring.initVar.buttonBar -row 999 -column 0 -columnspan 1000
1038  bind .wiring.initVar <Key-Return> {invokeOKorCancel .wiring.initVar.buttonBar}
1039  bind .wiring.initVar <Key-Escape> {.wiring.initVar.buttonBar.cancel invoke}
1040 
1041  global rowdict
1042  global varInput initVar_name
1043  set rowdict(Name) 10
1044  set initVar_name entry10
1045  grid [label .wiring.initVar.label10 -text Name] -row 10 -column 10 -sticky e
1046  grid [ttk::combobox .wiring.initVar.entry10 -textvariable varInput(Name)] -row 10 -column 20 -sticky ew -columnspan 2
1047 
1048  set rowdict(Type) 20
1049  grid [label .wiring.initVar.label20 -text "Type"] -row 20 -column 10 -sticky e
1050  grid [ttk::combobox .wiring.initVar.entry20 -textvariable varInput(Type) \
1051  -state readonly -values "constant parameter flow integral"] \
1052  -row 20 -column 20 -sticky ew -columnspan 2
1053 
1054  # disable or enable the name field depending on type being selected
1055  bind .wiring.initVar.entry20 <<ComboboxSelected>> {
1056  if {[.wiring.initVar.entry20 get]=="constant"} {
1057  .wiring.initVar.entry10 configure -state disabled
1058  } else {
1059  .wiring.initVar.entry10 configure -state normal
1060  }
1061  }
1062 
1063  # initialise variable type when selected from combobox
1064  bind .wiring.initVar.entry10 <<ComboboxSelected>> {
1065  getValue [.wiring.initVar.entry10 get]
1066  .wiring.initVar.entry20 set [value.type]
1067  }
1068 
1069  set row 30
1070  foreach var {
1071  "Value"
1072  "Units"
1073  "Rotation"
1074  "Short description"
1075  "Detailed description"
1076  "Slider Bounds: Max"
1077  "Slider Bounds: Min"
1078  "Slider Step Size"
1079  } {
1080  set rowdict($var) $row
1081  grid [label .wiring.initVar.label$row -text $var] -row $row -column 10 -sticky e
1082  grid [entry .wiring.initVar.entry$row -textvariable varInput($var)] -row $row -column 20 -sticky ew -columnspan 2
1083  incr row 10
1084  }
1085  set varInput(initial_focus) .wiring.initVar.entry$rowdict(Name)
1086  } else {
1087  wm deiconify .wiring.initVar
1088  }
1089 }
1090 
1091 proc deiconifyEditConstant {} {
1092  if {![winfo exists .wiring.editConstant]} {
1093  toplevel .wiring.editConstant
1094  wm resizable .wiring.editConstant 0 0
1095  wm transient .wiring.editConstant .wiring
1096 
1097  global constInput rowdict
1098  set row 0
1099  grid [label .wiring.editConstant.title -textvariable constInput(title)] -row $row -column 0 -columnspan 999 -pady 10
1100  frame .wiring.editConstant.buttonBar
1101  button .wiring.editConstant.buttonBar.ok -text OK -command {eval $constInput(command)}
1102  button .wiring.editConstant.buttonBar.cancel -text Cancel -command {eval $constInput(cancelCommand)}
1103  pack .wiring.editConstant.buttonBar.ok [label .wiring.editConstant.buttonBar.spacer -width 2] .wiring.editConstant.buttonBar.cancel -side left -pady 10
1104  grid .wiring.editConstant.buttonBar -row 999 -column 0 -columnspan 1000
1105 
1106  foreach var {
1107  "Name"
1108  "Value"
1109  "Expression"
1110  "Units"
1111  "Rotation"
1112  "Slider Bounds: Max"
1113  "Slider Bounds: Min"
1114  "Slider Step Size"
1115  } {
1116  set rowdict($var) $row
1117  label .wiring.editConstant.label$row -text $var
1118  entry .wiring.editConstant.entry$row -textvariable constInput($var)
1119  incr row 10
1120  }
1121  set constInput(initial_focus) .wiring.editConstant.entry$rowdict(Name)
1122  # setup textvariable for label of "Value"
1123  set row "$rowdict(Value)"
1124  .wiring.editConstant.label$row configure -textvariable constInput(ValueLabel)
1125 
1126  # adjust "Slider Step Size" row to include "relative" radiobutton
1127  set row "$rowdict(Slider Step Size)"
1128  grid configure .wiring.editConstant.entry$row -columnspan 1
1129  grid [checkbutton .wiring.editConstant.checkbox$row -text "relative" -variable "constInput(relative)"] -row $row -column 21 -sticky ew -columnspan 1
1130 
1131  bind .wiring.editConstant <Key-Return> {invokeOKorCancel .wiring.editConstant.buttonBar}
1132  bind .wiring.editConstant <Key-Escape> {.wiring.editConstant.buttonBar.cancel invoke}
1133 
1134  } else {
1135  wm deiconify .wiring.editConstant
1136  }
1137 }
1138 proc deiconifyEditOperation {} {
1139  if {![winfo exists .wiring.editOperation]} {
1140  global opInput
1141  toplevel .wiring.editOperation
1142  wm resizable .wiring.editOperation 0 0
1143  wm title .wiring.editOperation "Edit Operation"
1144  wm transient .wiring.editOperation .wiring
1145 
1146  frame .wiring.editOperation.buttonBar
1147  label .wiring.editOperation.title -textvariable opInput(title)
1148  pack .wiring.editOperation.title -pady 10
1149  button .wiring.editOperation.buttonBar.ok -text OK -command {
1150  minsky.canvas.item.rotation [set opInput(Rotation)]
1151  minsky.canvas.item.axis [set opInput(Axis)]
1152  minsky.canvas.item.arg [set opInput(Argument)]
1153  closeEditWindow .wiring.editOperation
1154  }
1155  button .wiring.editOperation.buttonBar.cancel -text Cancel -command {
1156  closeEditWindow .wiring.editOperation}
1157  bind .wiring.editOperation <Key-Return> {invokeOKorCancel .wiring.editOperation.buttonBar}
1158  bind .wiring.editOperation <Key-Escape> {.wiring.editOperation.buttonBar.cancel invoke}
1159  pack .wiring.editOperation.buttonBar.ok [label .wiring.editOperation.buttonBar.spacer -width 2] .wiring.editOperation.buttonBar.cancel -side left -pady 10
1160  pack .wiring.editOperation.buttonBar -side bottom
1161 
1162 
1163  frame .wiring.editOperation.rotation
1164  label .wiring.editOperation.rotation.label -text "Rotation" -width 10
1165  entry .wiring.editOperation.rotation.value -width 20 -textvariable opInput(Rotation)
1166  pack .wiring.editOperation.rotation.value .wiring.editOperation.rotation.label -side right
1167  pack .wiring.editOperation.rotation
1168  set opInput(initial_focus) .wiring.editOperation.rotation.value
1169 
1170  frame .wiring.editOperation.axis
1171  label .wiring.editOperation.axis.label -text "Axis" -width 10
1172  ttk::combobox .wiring.editOperation.axis.value -width 20 -textvariable opInput(Axis)
1173  pack .wiring.editOperation.axis.value .wiring.editOperation.axis.label -side right
1174  pack .wiring.editOperation.axis
1175  tooltip .wiring.editOperation.axis.label "Some tensor operations operate along a particular axis"
1176 
1177  frame .wiring.editOperation.arg
1178  label .wiring.editOperation.arg.label -text "Argument" -width 10
1179  ttk::combobox .wiring.editOperation.arg.value -width 20 -textvariable opInput(Argument)
1180  pack .wiring.editOperation.arg.value .wiring.editOperation.arg.label -side right
1181  pack .wiring.editOperation.arg
1182 
1183  tooltip .wiring.editOperation.arg.label "Some operations have an argument, such as the difference operation"
1184  } else {
1185  wm deiconify .wiring.editOperation
1186  }
1187  .wiring.editOperation.axis.value configure -values [minsky.canvas.item.dimensions]
1188  set opInput(Axis) [minsky.canvas.item.axis]
1189  set opInput(Argument) [minsky.canvas.item.arg]
1190 }
1191 
1192 proc closeEditWindow {window} {
1193  grab release $window
1194  destroy $window
1195 }
1196 
1197 proc editVar {} {
1198  global editVarInput
1199  set item minsky.canvas.item
1200  getValue [$item.valueId]
1201  deiconifyEditVar
1202  wm title .wiring.editVar "Edit [$item.name]"
1203  # populate combobox with existing variable names
1204  .wiring.editVar.entry10 configure -values [$item.accessibleVars]
1205 
1206 
1207  set "editVarInput(Name)" [$item.name]
1208  set "editVarInput(Type)" [$item.type]
1209  set "editVarInput(Initial Value)" [$item.init]
1210  set "editVarInput(Units)" [value.units.str]
1211  set "editVarInput(Rotation)" [$item.rotation]
1212  set "editVarInput(Slider Bounds: Max)" [$item.sliderMax]
1213  set "editVarInput(Slider Bounds: Min)" [$item.sliderMin]
1214  set "editVarInput(Slider Step Size)" [$item.sliderStep]
1215  set "editVarInput(relative)" [$item.sliderStepRel]
1216 # set "editVarInput(Short description)" [$item.tooltip]
1217 # set "editVarInput(Detailed description)" [$item.detailedText]
1218  if {[minsky.value.godleyOverridden] || [inputWired [$item.valueId]]} {
1219  $editVarInput(initial_focus_value) configure -state disabled -foreground gray
1220  ::tk::TabToWindow $editVarInput(initial_focus_rotation)
1221  } else {
1222  $editVarInput(initial_focus_value) configure -state normal -foreground black
1223  ::tk::TabToWindow $editVarInput(initial_focus_value)
1224  }
1225  switch [$item.type] {
1226  "constant" -
1227  "flow" {$editVarInput(units_focus_value) configure -state disabled -foreground gray}
1228  }
1229 
1230  set value "unknown"
1231  catch {set value [value.value]}
1232  set editVarInput(title) "[$item.name]: Value=$value"
1233  ensureWindowVisible .wiring.editVar
1234  grab set .wiring.editVar
1235  wm transient .wiring.editVar
1236 }
1237 
1238 proc setDataValue {} {
1239  global constInput
1240  set item minsky.canvas.item
1241  eval [set item].description "$constInput(Name)"
1242  $item.rotation $constInput(Rotation)
1243  if [llength [info commands $item.expression]] {
1244  $item.expression $constInput(Expression)
1245  }
1246 }
1247 
1248 proc setIntegralIValue {} {
1249  global constInput
1250  set item minsky.canvas.item
1251  $item.description $constInput(Name)
1252  # description may have change intVar, so use value instead to set init
1253  getValue [$item.valueId]
1254  value.init $constInput(Value)
1255  value.setUnits $constInput(Units)
1256  $item.rotation $constInput(Rotation)
1257 }
1258 
1259 proc cleanEditConstantConfig {} {
1260  global rowdict
1261  foreach name [array names rowdict] {
1262  set row $rowdict($name)
1263  catch {grid remove .wiring.editConstant.label$row .wiring.editConstant.entry$row}
1264  }
1265 }
1266 
1267 proc configEditConstantForIntegral {} {
1268  global rowdict
1269  cleanEditConstantConfig
1270  set i 10
1271  foreach var {
1272  "Name"
1273  "Value"
1274  "Units"
1275  "Rotation"
1276  } {
1277  set row $rowdict($var)
1278  grid .wiring.editConstant.label$row -row $i -column 10 -sticky e
1279  grid .wiring.editConstant.entry$row -row $i -column 20 -sticky ew -columnspan 2
1280  incr i 10
1281  }
1282 }
1283 
1284 proc configEditConstantForData {} {
1285  global rowdict
1286  cleanEditConstantConfig
1287  set i 10
1288  set items {
1289  "Name"
1290  "Rotation"
1291  }
1292  if [llength [info commands minsky.canvas.item.expression]] {lappend items "Expression"}
1293 
1294  foreach var $items {
1295  set row $rowdict($var)
1296  grid .wiring.editConstant.label$row -row $i -column 10 -sticky e
1297  grid .wiring.editConstant.entry$row -row $i -column 20 -sticky ew -columnspan 2
1298  incr i 10
1299  }
1300 }
1301 
1302 proc editItem {} {
1303  global constInput varInput editVarInput opInput
1304  set item minsky.canvas.item
1305  switch -regexp [$item.classType] {
1306  "Variable*|VarConstant" {editVar}
1307  "Operation*" {
1308  set opType [minsky.canvas.item.type]
1309  set opInput(title) [minsky.canvas.item.type]
1310  set opInput(Rotation) [minsky.canvas.item.rotation]
1311  deiconifyEditOperation
1312  ::tk::TabToWindow $opInput(initial_focus);
1313  ensureWindowVisible .wiring.editOperation
1314  grab set .wiring.editOperation
1315  wm transient .wiring.editOperation
1316  }
1317  "IntOp|DataOp|UserFunction" {
1318  set constInput(Value) ""
1319  set "constInput(Slider Bounds: Min)" ""
1320  set "constInput(Slider Bounds: Max)" ""
1321  set "constInput(Slider Step Size)" ""
1322  deiconifyEditConstant
1323  wm title .wiring.editConstant "Edit Integral"
1324  set constInput(ValueLabel) "Initial Value"
1325  if {[$item.classType]=="IntOp"} {
1326  set constInput(Value) [$item.intVar.init]
1327  set constInput(Units) [$item.intVar.unitsStr]
1328  set setValue setIntegralIValue
1329  configEditConstantForIntegral
1330  } else {
1331  set setValue setDataValue
1332  configEditConstantForData
1333  }
1334  set constInput(Name) [$item.description]
1335  set constInput(title) $constInput(Name)
1336  set constInput(Rotation) [$item.rotation]
1337  if [llength [info commands minsky.canvas.item.expression]] {
1338  set constInput(Expression) [$item.expression]
1339  }
1340  # value needs to be regotten, as var name may have changed
1341  set constInput(command) "
1342  $setValue
1343  closeEditWindow .wiring.editConstant
1344  "
1345  set constInput(cancelCommand) "closeEditWindow .wiring.editConstant"
1346 
1347  ::tk::TabToWindow $constInput(initial_focus);
1348  ensureWindowVisible .wiring.editConstant
1349  grab set .wiring.editConstant
1350  wm transient .wiring.editConstant
1351  }
1352  "Group" {groupEdit}
1353  "GodleyIcon" {openGodley [minsky.openGodley]}
1354  # plot widgets are slightly different, in that double-click
1355  # expands the plot, rather than edits.
1356  "PlotWidget" {plotDoubleClick [TCLItem]}
1357  "Item" {postNote item}
1358  }
1359 }
1360 
1361 proc importData {} {
1362  global workDir
1363  set f [tk_getOpenFile -multiple 1 -initialdir $workDir]
1364  if [string length $f] {
1365  set workDir [file dirname $f]
1366  eval minsky.canvas.item.readData {$f}
1367  }
1368 }
1369 
1370 proc initRandom {} {
1371  if {![winfo exists .wiring.initRandom]} {
1372  toplevel .wiring.initRandom
1373  frame .wiring.initRandom.xmin
1374  label .wiring.initRandom.xmin.label -text "min x value"
1375  entry .wiring.initRandom.xmin.entry -width 40 -justify left
1376  pack .wiring.initRandom.xmin.label .wiring.initRandom.xmin.entry -side left
1377  .wiring.initRandom.xmin.entry insert 0 "0"
1378  frame .wiring.initRandom.xmax
1379  label .wiring.initRandom.xmax.label -text "max x value"
1380  entry .wiring.initRandom.xmax.entry -width 40 -justify left
1381  pack .wiring.initRandom.xmax.label .wiring.initRandom.xmax.entry -side left
1382  .wiring.initRandom.xmax.entry insert 0 "1"
1383  frame .wiring.initRandom.numVals
1384  label .wiring.initRandom.numVals.label -text "number of samples"
1385  entry .wiring.initRandom.numVals.entry -width 40 -justify left
1386  .wiring.initRandom.numVals.entry insert 0 "100"
1387  pack .wiring.initRandom.numVals.label .wiring.initRandom.numVals.entry -side left
1388  frame .wiring.initRandom.buttonBar
1389  button .wiring.initRandom.buttonBar.cancel -text "Cancel" -command {closeEditWindow .wiring.initRandom}
1390  button .wiring.initRandom.buttonBar.ok -text "OK" -command doInitRandom
1391  pack .wiring.initRandom.buttonBar.cancel .wiring.initRandom.buttonBar.ok -side left
1392  pack .wiring.initRandom.xmin .wiring.initRandom.xmax .wiring.initRandom.numVals .wiring.initRandom.buttonBar
1393  bind .wiring.initRandom <Key-Escape> {.wiring.initRandom.buttonBar.cancel invoke}
1394  bind .wiring.initRandom <Key-Return> {.wiring.initRandom.buttonBar.ok invoke}
1395  } else {
1396  deiconify .wiring.initRandom
1397  }
1398  ensureWindowVisible .wiring.initRandom
1399  grab set .wiring.initRandom
1400  wm transient .wiring.initRandom
1401 }
1402 
1403 proc doInitRandom {} {
1404  minsky.canvas.item.initRandom [.wiring.initRandom.xmin.entry get] [.wiring.initRandom.xmax.entry get] [.wiring.initRandom.numVals.entry get]
1405  closeEditWindow .wiring.initRandom
1406 }
1407 
1408 proc deiconifyNote {} {
1409  if {![winfo exists .wiring.note]} {
1410  toplevel .wiring.note
1411  frame .wiring.note.tooltip
1412  label .wiring.note.tooltip.bookmark -text "Bookmark?"
1413  checkbutton .wiring.note.tooltip.bookmarkCheck
1414  label .wiring.note.tooltip.label -text "Short description"
1415  entry .wiring.note.tooltip.entry -width 40 -justify left
1416  pack .wiring.note.tooltip.bookmark .wiring.note.tooltip.bookmarkCheck .wiring.note.tooltip.label .wiring.note.tooltip.entry -side left
1417  text .wiring.note.text -wrap word
1418  frame .wiring.note.buttons
1419  button .wiring.note.buttons.cancel -text "Cancel" -command {closeEditWindow .wiring.note}
1420  button .wiring.note.buttons.ok -text "OK" -command OKnote
1421  bind .wiring.note <Key-Escape> {.wiring.note.buttons.cancel invoke}
1422  pack .wiring.note.buttons.cancel .wiring.note.buttons.ok -side left
1423  pack .wiring.note.tooltip .wiring.note.text .wiring.note.buttons
1424  } else {
1425  wm deiconify .wiring.note
1426  }
1427 }
1428 
1429 set bookmarkCheck 0
1430 proc postNote {item} {
1431  deiconifyNote
1432  .wiring.note.tooltip.entry delete 0 end
1433 # .wiring.note.tooltip.entry insert 0 [minsky.canvas.$item.tooltip]
1434  .wiring.note.text delete 1.0 end
1435 # .wiring.note.text insert 1.0 [minsky.canvas.$item.detailedText]
1436  .wiring.note.buttons.ok configure -command "OKnote $item"
1437  global bookmarkCheck
1438  set bookmarkCheck [minsky.canvas.$item.bookmark]
1439  ensureWindowVisible .wiring.note
1440  grab set .wiring.note
1441  wm transient .wiring.note
1442 }
1443 
1444 proc OKnote {item} {
1445 # minsky.canvas.$item.tooltip [.wiring.note.tooltip.entry get]
1446 # minsky.canvas.$item.detailedText [string trim [.wiring.note.text get 1.0 end]]
1447  global bookmarkCheck
1448  minsky.canvas.$item.bookmark $bookmarkCheck
1449  minsky.canvas.$item.adjustBookmark
1450  # update bounding box - see ticket #1164
1451  if [ string equal $item "item"] then {minsky.canvas.$item.updateBoundingBox}
1452  closeEditWindow .wiring.note
1453 }
1454 
1455 proc tout {args} {
1456  puts "$args"
1457 }
1458 
1459 # # example debugging trace statements
1460 # #trace add execution placeNewVar enterstep tout
1461 # #trace add execution move enterstep tout
1462 #