home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops Manual / Demo folder / grDemo next >
Encoding:
Text File  |  1994-10-24  |  8.6 KB  |  309 lines  |  [TEXT/MSET]
  1. \ grdemo - source for Curves, a simple Mops application.
  2.  
  3. \ Dec 93    mrh    Rewritten for the new View scheme.
  4.  
  5. need    window+
  6. need    turtle
  7.  
  8.  
  9. \ Class Readout is a view which shows a box with a value in it.
  10.  
  11. :class  READOUT  super{ view }
  12.  
  13.     int        myValue
  14.  
  15. :m PUT:        put: myValue  ;m
  16.  
  17. :m DRAW:
  18.     clear: tempRect  draw: tempRect
  19.     -curs  3 10 gotoXY
  20.     1 tmode   9 tsize  1 tfont        \ Geneva 9
  21.     get: myValue  3 .r  ;m
  22.  
  23. ;class
  24.  
  25.  
  26. \ Class Indicator is a view which has two child views - a vertical scroll
  27. \ bar and a Readout box with the corresponding digital value.  These
  28. \ child views are set up as ivars of the Indicator.
  29.  
  30. :class  INDICATOR  super{ view }
  31.  
  32.     vScroll        theVScroll
  33.     Readout        theReadout
  34.  
  35. :m GET:
  36.     get: theVscroll  ;m
  37.  
  38. :m DRAW:
  39.     get: theVscroll  put: theReadout  (draw): super  ;m
  40.  
  41. :m MOVED:
  42.     clear: self  moved: super  ;m
  43.  
  44. :m PUTRANGE:    \ ( val -- )
  45.     putRange: theVscroll  ;m
  46.  
  47. :m Actions:    \ ( action-list -- )
  48.     actions: theVScroll  ;m
  49.  
  50. :m NEW: 
  51.     addr: theVscroll  addView: self
  52.     addr: theReadout  addView: self
  53.     new: super
  54. ;m
  55.  
  56.  
  57. \ The Classinit: method for Indicator positions the two child views.
  58. \ This can be done at compile time, since by using appropriate
  59. \ justifications, the bounds values for the children never change.
  60. \ Even if the Indicator resizes, the children still come out right.
  61.  
  62. :m CLASSINIT:
  63.     parCenter    parTop        parCenter    parBottom    setJust: theVscroll
  64.     -8            0            8            -20            setBounds: theVscroll
  65.     parCenter    parBottom    parCenter    parBottom    setJust: theReadout
  66.     -12             -16            12             0              setBounds: theReadout
  67.     classinit: super
  68. ;m
  69.  
  70. ;class
  71.  
  72.  
  73. \ Class Pane is a view which just overrides the MOVED: method, to clear
  74. \ its (old) area before relocating itself.  This is often needed for
  75. \ views, but not always.
  76.  
  77. :class  PANE    super{ view }
  78.  
  79. :m MOVED:    clear: self  moved: super  ;m
  80.  
  81. ;class
  82.  
  83.  
  84. \ Now, we build three instances of class Indicator. These will be the
  85. \ three control gadgets for Curves, for control of the graphics parameters
  86. \ by the user.
  87.  
  88. \ Again, by appropriate settings of the justifications and bounds, we
  89. \ can locate the Indicators at compile time, and they sort themselves
  90. \ out properly if the window is resized.
  91.  
  92. \ A variation would be to make the Indicators into ivars of the
  93. \ main window view, dView -- it would then be easy to have multiple
  94. \ windows.  At present dView is just a View, but we could easily subclass
  95. \ View, and have the Indicators as ivars of the new class.  In this case
  96. \ the setting of the justification and bounds would be moved into the
  97. \ Classinit: method of the new class.
  98.  
  99.  
  100. indicator    ind1
  101. indicator    ind2
  102. indicator    ind3
  103.  
  104. pane        dPane
  105.  
  106. \ Here are the justification/bounds settings for dPane and the 3 indicators.
  107. \ The parent here is dView, the contView of the window.
  108.  
  109.     parLeft        parTop    parRight    parBottom    setJust: dPane
  110.     0            0        -130        -16            setBounds: dPane
  111.  
  112.     parRight    parTop    parRight    parBottom    setJust: ind1
  113.     -120        20        -95            -30            setBounds: ind1
  114.                     
  115.     parRight    parTop    parRight    parBottom    setJust: ind2
  116.     -85            20        -60            -30            setBounds: ind2
  117.                     
  118.     parRight    parTop    parRight    parBottom    setJust: ind3
  119.     -50            20        -25            -30            setBounds: ind3
  120.  
  121.  
  122. \ To show how easy it is to reorganize things, if you uncomment out
  123. \ these lines below, and comment out the lines above, the indicators will
  124. \ appear below dPane instead of on the right hand side.  They will appear
  125. \ evenly spaced out across the window, and start just over halfway down.
  126. \ If you resize the window these relationships will be maintained, thanks
  127. \ to our parent proportional (parProp) justification mode.
  128.  
  129. \    parLeft        parTop    parRight    parProp        setJust: dPane
  130. \    0            0        -16            5000        setBounds: dPane
  131. \
  132. \    parLeft        parProp    parProp        parBottom    setJust: ind1
  133. \    0            5200    3333        -30            setBounds: ind1
  134. \                    
  135. \    parProp        parProp    parProp        parBottom    setJust: ind2
  136. \    3333        5200    6667        -30            setBounds: ind2
  137. \                    
  138. \    parProp        parProp    parRight    parBottom    setJust: ind3
  139. \    6667        5200    -16            -30            setBounds: ind3
  140.                     
  141.  
  142.  
  143. view    DVIEW        \ This is the "contView" which covers the whole of
  144.                     \  our window.  Dpane and the 3 Indicators will be
  145.                     \  child views of this -- we set up this relationship
  146.                     \  via AddView: messages in the NEW: method of grWind,
  147.                     \  our window class (see just below).
  148.  
  149.  
  150. \ Now we assign constants to the window bounds.  These constants relate to
  151. \ the global coordinates of the small Macintosh screen.  An improvement
  152. \ might be to use ScreenBits to get the actual screen size and compute
  153. \ the initial values.
  154.  
  155. 40    value    gwL    
  156. 60    value    gwT
  157. 470    value    gwR
  158. 290    value    gwB
  159.  
  160. rect    RR
  161.  
  162. \ Now we define a subclass of Window+ containing a drawing pane.
  163. \ This window will be a RndWind, draggable, non-growable.
  164.  
  165. :class    GRWIND  super{ window+ }
  166.                    
  167. :m NEW: { taddr tlen -- }    \ Creates a new grWind with a title
  168.                             \  passed in by the caller.
  169.                             
  170. \ First we set up the child view relationships.  dView will be the main
  171. \ view, and here we set up the other views as children of dView.
  172.  
  173.     dPane  addView: dView
  174.     ind1 addView: dView  ind2 addView: dView  ind3 addView: dView
  175.     
  176.     screenbits true setGrow: self    \ growable
  177.     true setZoom: self                \ zoomable
  178.     gwL  gwT gwR gwB  put: RR
  179.     RR tAddr tLen  docWind            \ initial rect, title, window type
  180.     true false                        \ visible, no close box
  181.     dView                            \ the main view
  182.     new: super                        \ create the window!
  183. ;m
  184.  
  185. ;class
  186.  
  187.  
  188. \ Here we instantiate grWind to create the Curves demo window.
  189.  
  190. grWind    DWIND
  191.  
  192.  
  193. \ Now come the words which get called when various things happen in our
  194. \ window.
  195.  
  196. : @DPARMS        \ ( -- p1 p2 p3 )   Draws the outline of the pane,
  197.                 \  and fetches the drawing parameters from the three
  198.                 \  scroll bars.
  199.     clear: tempRect  draw: tempRect
  200.     get: ind1  get: ind2  get: ind3  ;
  201.  
  202.  
  203. \ Now we define the 4 draw: handlers, 1 for each type of drawing. 
  204.  
  205. :a SPIRAL    @dparms  putRange: bic    spiral: bic    ;a
  206. :a SPIN        @dparms  putRange: anna   spin: anna    ;a
  207. :a LJ        @dparms  putRange: bic    lj: bic       ;a
  208.                 
  209. \ dragon requires start val on stack 
  210.  
  211. :a DRAGON    @dparms  putRange: bic  home: bic 
  212.         get: ind1  dragon: bic   ;a
  213.  
  214.  
  215. : !RANGES  { max1 max2 max3 -- }    \ Stores new parameter ranges for the 
  216.                     \  three scroll bars.
  217.     1  max1  putRange: ind1   1  max2  putRange: ind2  
  218.     1  max3  putRange: ind3  ;
  219.  
  220.  
  221. \ Text for the "about" display
  222.  
  223. scon    ab1    "Curves was originally written by Charles Duff."
  224. scon    ab2    "Adapted for Mops by Michael Hore."
  225.  
  226.  
  227. :a ABOUT  
  228.     20 tfont 0 tmode  14  tsize
  229.     getRect: dPane  put: tempRect
  230.     clip: tempRect  clear: tempRect
  231.     28 40 gotoxy ab1 type  30 70 gotoxy ab2 type
  232.     initFont  waitClick  update: dWind  ;a    
  233.  
  234. \ Here we tell the two Pen objects where to center themselves 
  235. \ when they do a Home: operation. Because these values will be retained
  236. \ in the pen objects when we do a SAVE, they can be set
  237. \ at compile time.
  238.  
  239. 150 110  center: bic
  240. 150 110  center: anna
  241.  
  242. \ Now we define the actions for the various control parts.
  243. \ each action handler executes a deferred get: on thisCtl, which
  244. \ is a value pointing to the control object that was clicked.
  245. \ The handler then modifies the value of the thumb, and causes
  246. \ an update event for dWind, which will cause it to be redrawn
  247. \ when the update event is handled.
  248.  
  249.  
  250. :a DOTHUMB        update: dWind  ;a
  251. :a DOPGUP        get: thisCtl  10 -  put: thisCtl  update: dWind  ;a 
  252. :a DOPGDN        get: thisCtl  10 +  put: thisCtl  update: dWind  ;a 
  253. :a DOLNUP        get: thisCtl  1-    put: thisCtl  update: dWind  ;a 
  254. :a DOLNDN        get: thisCtl  1+    put: thisCtl  update: dWind  ;a 
  255.  
  256. ' lj  setdraw: dPane
  257.  
  258. xts{  doLnUp doLnDn doPgUp doPgDn doThumb  }   actions: ind1
  259. xts{  doLnUp doLnDn doPgUp doPgDn doThumb  }   actions: ind2
  260. xts{  doLnUp doLnDn doPgUp doPgDn doThumb  }   actions: ind3
  261.  
  262. \ Define the menus for this application.  AppleMen is already there.
  263.  
  264. 6    menu    GRAFMEN
  265.  
  266. \ Define the menu handler words. Each one sets a new handler
  267. \ for dWind's DRAW method, and then sets appropriate ranges and 
  268. \ titles for the scroll bars, and causes an update event.
  269.  
  270. :a DOLISS        \ Does lissagous curves
  271.     ['] lj  setdraw: dPane  200 200 179  !ranges 
  272.     update: dWind  ;a
  273.  
  274. :a DOSPIRAL    \ Does spirals
  275.     ['] spiral  setDraw: dPane  10 20 179  !ranges  
  276.     update: dWind  ;a
  277.  
  278. :a DOSPIN    \ Does spinPolys
  279.     ['] spin  setDraw: dPane  8 10 179  !ranges  
  280.     update: dWind  ;a
  281.  
  282. :a DODRAG    \ Does Dragon curves
  283.     ['] dragon  setDraw: dPane  8 20 179  !ranges  
  284.     update: dWind  ;a
  285.  
  286. : SETREPS    \ Sets max reps in bic
  287.     300 putMax: bic  100 putMax: anna  ;
  288.  
  289. :a SAYONARA    bye  ;a
  290.  
  291. xts{  about doDsk  }        1  init: appleMen
  292. xts{  doLiss  doSpiral  doSpin  doDrag  null  sayonara  }
  293.                             2  init: grafMen
  294.  
  295. \ Here's the startup word for the turtle graphics demo.
  296.  
  297. : GO    
  298.     instld?  NIF  " demo.rsrc" openresfile   THEN
  299.     " Curves"  new: dWind
  300.     getnew: appleMen  getnew: grafMen
  301.     appleMen  grafMen  2  init: menubar
  302.     setReps  200 200 179  !ranges  ( for Liss )  -echo -curs
  303.     eventLoop  ;            \ Listen to events and act on them
  304.     
  305.  
  306. \ Here's the error word:
  307.  
  308. : CRASH        3 beep 3 beep  sayonara  ;
  309.