home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vboptionme.tcl < prev    next >
Text File  |  1997-10-13  |  7KB  |  244 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)vboptionme.tcl    /main/titanic/6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)vboptionme.tcl    /main/titanic/6   13 Oct 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class VBOptionMenuProcs : {Object} {
  16.     constructor
  17.     method destructor
  18. }
  19.  
  20. constructor VBOptionMenuProcs {class this name} {
  21.     set this [Object::constructor $class $this $name]
  22.     # Start constructor user section
  23.     # End constructor user section
  24.     return $this
  25. }
  26.  
  27. method VBOptionMenuProcs::destructor {this} {
  28.     # Start destructor user section
  29.     # End destructor user section
  30. }
  31.  
  32. proc VBOptionMenuProcs::redraw {} {
  33.     [.main infoView] redraw
  34. }
  35.  
  36. proc VBOptionMenuProcs::zoomIn {} {
  37.  
  38.     VBProcs::zoom 1.333333333333
  39.     set scale [[.main infoView] scale]
  40.     if {[m4_var get M4_zoom -context vb] != $scale} {
  41.         catch {m4_var set M4_zoom $scale -context vb}
  42.     }
  43. }
  44.  
  45. proc VBOptionMenuProcs::zoomOut {} {
  46.  
  47.     VBProcs::zoom 0.75
  48.     set scale [[.main infoView] scale]
  49.     if {[m4_var get M4_zoom -context vb] != $scale} {
  50.         catch {m4_var set M4_zoom $scale -context vb}
  51.     }
  52. }
  53.  
  54. proc VBOptionMenuProcs::selectFontA {} {
  55.     busy {
  56.     uplevel #0 require udefontcho.tcl
  57.     set scale [[.main infoView] scale]
  58.     set scaledFont [VBProcs::scaleFont [m4_var get M4_font_bold -context vb] $scale]
  59.     UdeFontChooser new .main.fonta \
  60.         -options .main \
  61.         -title "Font" \
  62.         -orgFont "$scaledFont" \
  63.         -value "$scaledFont" \
  64.         -cancelPressed {%this delete} \
  65.         -okPressed {
  66.         set scale [expr 1 / [[.main infoView] scale]]
  67.         set scaledFont [VBProcs::scaleFont [%this value] $scale]
  68.         if {[%this orgFont] != "$scaledFont"} {
  69.             [.main infoView] fontASpec "$scaledFont"
  70.             catch {m4_var set M4_font_bold "$scaledFont" -context vb}
  71.         }
  72.         %this delete
  73.         }
  74.     }
  75.     .main.fonta popUp
  76. }
  77.  
  78. proc VBOptionMenuProcs::selectFontB {} {
  79.     busy {
  80.     uplevel #0 require udefontcho.tcl
  81.     set scale [[.main infoView] scale]
  82.     set scaledFont [VBProcs::scaleFont [m4_var get M4_font -context vb] $scale]
  83.     UdeFontChooser new .main.fontb \
  84.         -options .main \
  85.         -title "Font" \
  86.         -orgFont "$scaledFont" \
  87.         -value "$scaledFont" \
  88.         -cancelPressed {%this delete} \
  89.         -okPressed {
  90.         set scale [expr 1 / [[.main infoView] scale]]
  91.         set scaledFont [VBProcs::scaleFont [%this value] $scale]
  92.         if {[%this orgFont] != "$scaledFont"} {
  93.             [.main infoView] fontBSpec "$scaledFont"
  94.             catch {m4_var set M4_font "$scaledFont" -context vb}
  95.         }
  96.         %this delete
  97.         }
  98.     }
  99.     .main.fontb popUp
  100. }
  101.  
  102. proc VBOptionMenuProcs::selectForegroundColor {} {
  103.     uplevel #0 require udecolorch.tcl
  104.     UdeColorChooser new .main.fg \
  105.     -options .main \
  106.     -title "Foreground Color" \
  107.     -value [m4_var get M4_fg -context vb] \
  108.     -cancelPressed {%this delete} \
  109.     -okPressed {
  110.         if {[m4_var get M4_fg -context vb] != [%this value]} {
  111.         [.main infoView] areaForeground [%this value]
  112.         catch {m4_var set M4_fg [%this value] -context vb}
  113.         }
  114.         %this delete
  115.     }
  116.     .main.fg popUp
  117. }
  118.  
  119. proc VBOptionMenuProcs::selectBackgroundColor {} {
  120.     uplevel #0 require udecolorch.tcl
  121.     UdeColorChooser new .main.bg \
  122.     -options .main \
  123.     -title "Background Color" \
  124.     -value [m4_var get M4_bg -context vb] \
  125.     -cancelPressed {%this delete} \
  126.     -okPressed {
  127.         if {[m4_var get M4_bg -context vb] != [%this value]} {
  128.         [.main infoView] areaBackground [%this value]
  129.         catch {m4_var set M4_bg [%this value] -context vb}
  130.         }
  131.         %this delete
  132.     }
  133.     .main.bg popUp
  134. }
  135.  
  136. proc VBOptionMenuProcs::selectNodeColor {} {
  137.     uplevel #0 require udecolorch.tcl
  138.     UdeColorChooser new .main.nc \
  139.     -options .main \
  140.     -title "Node Color" \
  141.     -value [m4_var get "M4_node_color" -context vb] \
  142.     -cancelPressed {%this delete} \
  143.     -okPressed {
  144.         if {[m4_var get "M4_node_color" -context vb] != [%this value]} {
  145.         [.main infoView] nodeColor [%this value]
  146.         catch {m4_var set "M4_node_color" [%this value] -context vb}
  147.         }
  148.         %this delete
  149.     }
  150.     .main.nc popUp
  151. }
  152.  
  153. proc VBOptionMenuProcs::selectPrimarySelectionColor {} {
  154.     uplevel #0 require udecolorch.tcl
  155.     UdeColorChooser new .main.selColor \
  156.     -options .main \
  157.     -title "Primary Selection Color" \
  158.     -value [m4_var get "M4_sel_color" -context vb] \
  159.     -cancelPressed {%this delete} \
  160.     -okPressed {
  161.         if {[m4_var get "M4_sel_color" -context vb] != [%this value]} {
  162.         [.main infoView] selAColor [%this value]
  163.         catch {m4_var set "M4_sel_color" [%this value] -context vb}
  164.         }
  165.         %this delete
  166.     }
  167.     .main.selColor popUp
  168. }
  169.  
  170. proc VBOptionMenuProcs::selectSecundairySelectionColor {} {
  171.     uplevel #0 require udecolorch.tcl
  172.     UdeColorChooser new .main.selBColor \
  173.     -options .main \
  174.     -title "Secondairy Selection Color" \
  175.     -value [m4_var get "M4_selsecond_color" -context vb] \
  176.     -cancelPressed {%this delete} \
  177.     -okPressed {
  178.         if {[m4_var get "M4_selsecond_color" -context vb] != [%this value]} {
  179.         [.main infoView] selBColor [%this value]
  180.         catch {m4_var set "M4_selsecond_color" [%this value] -context vb}
  181.         }
  182.         %this delete
  183.     }
  184.     .main.selBColor popUp
  185. }
  186.  
  187. proc VBOptionMenuProcs::selectMergeArrowColor {} {
  188.     uplevel #0 require udecolorch.tcl
  189.     UdeColorChooser new .main.mergeColor \
  190.     -options .main \
  191.     -title "Merge Arrow Color" \
  192.     -value [m4_var get "M4_merge_color" -context vb] \
  193.     -cancelPressed {%this delete} \
  194.     -okPressed {
  195.         if {[m4_var get "M4_merge_color" -context vb] != [%this value]} {
  196.         [.main infoView] mergeColor [%this value]
  197.         catch {m4_var set "M4_merge_color" [%this value] -context vb}
  198.         }
  199.         %this delete
  200.     }
  201.     .main.mergeColor popUp
  202. }
  203.  
  204. proc VBOptionMenuProcs::printerSetup {} {
  205.     # better: make psPrinterSetup in ToolOptions static
  206.     if ![isCommand .main.toolOptions] {
  207.         require "tooloption.tcl"
  208.         ToolOptions new .main.toolOptions
  209.     }
  210.     .main.toolOptions psPrinterSetup
  211. }
  212.  
  213. proc VBOptionMenuProcs::printOptions {} {
  214.     if ![isCommand .main.optionBox] {
  215.         require "vbprintopt.tcl"
  216.         VBPrintOptionsDialog new .main.optionBox
  217.     }
  218.     .main.optionBox popUp
  219. }
  220.  
  221. proc VBOptionMenuProcs::compareCmd {} {
  222.  
  223.     # retrieve M4 variables
  224.     set M4_diff [m4_var get M4_diff]
  225.  
  226.     # create dialog box
  227.     EntryDialog new .main.compareCommand \
  228.     -modal yes \
  229.     -title "Compare Command" \
  230.     -message "Compare Command:" \
  231.     -entry $M4_diff \
  232.     -helpPressed {.main helpOnName compareCommand} \
  233.     -cancelPressed {%this delete} \
  234.     -okPressed {
  235.         if {"[m4_var get M4_diff]" != "[%this entry]"} {
  236.             catch {m4_var set M4_diff [%this entry]}
  237.         }
  238.         %this delete
  239.     }
  240.     .main.compareCommand popUp
  241. }
  242.  
  243. # Do not delete this line -- regeneration end marker
  244.