src/DrawResources/Move.tcl

   1 # Copyright (c) 1999-2014 OPEN CASCADE SAS
   2 #
   3 # This file is part of Open CASCADE Technology software library.
   4 #
   5 # This library is free software; you can redistribute it and/or modify it under
   6 # the terms of the GNU Lesser General Public License version 2.1 as published
   7 # by the Free Software Foundation, with special exception defined in the file
   8 # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
   9 # distribution for complete text of the license and disclaimer of any warranty.
  10 #
  11 # Alternatively, this file may be used under the terms of Open CASCADE
  12 # commercial license or contractual agreement.
  13
  14 #
  15 #  02/02/1996 : pbo : creation
  16 #  25/10/1996 : pbo : add 2d view
  17 #
  18 #  rotation/panning/zoom with buttons
  19 #
  20
  21 frame .move -relief groove -borderwidth 1
  22 #toplevel .move
  23
  24 frame .move.rotate -borderwidth 1
  25 label .move.rotate.title -text " Rotation "
  26 button .move.rotate.l   -text " < " -command {l ; repaint}
  27 button .move.rotate.r   -text " > " -command {r ; repaint}
  28 button .move.rotate.u   -text " ^ " -command {u ; repaint}
  29 button .move.rotate.d   -text " v " -command {d ; repaint}
  30 pack .move.rotate.title -side top
  31 pack .move.rotate.l -side left
  32 pack .move.rotate.r -side right
  33 pack .move.rotate.u -side top
  34 pack .move.rotate.d -side bottom
  35 pack .move.rotate
  36
  37 frame .move.panning -borderwidth 1
  38 label .move.panning.title -text " Panning "
  39 button .move.panning.l   -text " < " -command {pl ; 2dpl ; repaint}
  40 button .move.panning.r   -text " > " -command {pr ; 2dpr ; repaint}
  41 button .move.panning.u   -text " ^ " -command {pu ; 2dpu ; repaint}
  42 button .move.panning.d   -text " v " -command {pd ; 2dpd ; repaint}
  43 pack .move.panning.title -side top
  44 pack .move.panning.l -side left
  45 pack .move.panning.r -side right
  46 pack .move.panning.u -side top
  47 pack .move.panning.d -side bottom
  48 pack .move.panning
  49
  50 frame .move.zoom -borderwidth 1
  51 label .move.zoom.title -text " Zoom "
  52 button .move.zoom.mu   -text " + " -command {mu    ; 2dmu ; repaint}
  53 button .move.zoom.md   -text " - " -command {md    ; 2dmd ; repaint}
  54 button .move.zoom.fit  -text "max" -command {fit   ; 2dfit; repaint}
  55 button .move.zoom.w    -text "win" -command {wzoom ;        repaint}
  56 pack .move.zoom.title -side top
  57 pack .move.zoom.w -side left
  58 pack .move.zoom.fit -side right
  59 pack .move.zoom.mu -side top
  60 pack .move.zoom.md -side bottom
  61 pack .move.zoom
  62
  63 frame .pick -borderwidth 1
  64 label .pick.title -text " Pick "
  65 button .pick.coords -text "Coords" -command {catch {puts [mpick]}}
  66 button .pick.dist -text "Dist" -command {catch {puts [mdist]}}
  67 button .pick.whatis -text "What is" -command {catch {puts [whatis .]}}
  68 button .pick.erase -text "Erase" -command {catch {puts [erase .]}}
  69 pack .pick.title
  70 pack .pick.coords -pady 2 -padx 10
  71 pack .pick.dist -pady 2 -padx 10
  72 pack .pick.whatis -pady 2 -padx 10
  73 pack .pick.erase -pady 2 -padx 10
  74
  75 set ShowExtCommands 0
  76
  77 proc ShowHideExtCommands {} {
  78     global ShowExtCommands
  79     if $ShowExtCommands {
  80         pack .move -pady 1 -padx 1 -side left
  81         pack .pick -pady 1 -padx 1
  82     } else {
  83         pack forget .move .pick
  84     }
  85 }