home *** CD-ROM | disk | FTP | other *** search
/ European Smalltalk User Group 2004 September / esugcd.iso / Books-Tutorial-Lectures / Tutorials / st-course / source / Examples-Lamps.st next >
Encoding:
Text File  |  1999-02-02  |  9.5 KB  |  444 lines
  1. Controller subclass: #LampController
  2.     instanceVariableNames: ''
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'Examples-Lamps'!
  6.  
  7.  
  8. !LampController methodsFor: 'processing'!
  9.  
  10. processKeyboard
  11.  
  12.     | int |
  13.     int := sensor keyboard digitValue.
  14.     (int between: 1 and: model size)
  15.         ifTrue: [(model at: int) state: 1].!
  16.  
  17. processRedButton
  18.     "This method is called when the red button is pressed."
  19.  
  20.     | mpt image box |
  21.  
  22.     "Wait for the mouse button to be released."
  23.     sensor waitNoButton.
  24.  
  25.     "Get the point where the red mouse button was last pressed down."
  26.     mpt := sensor lastDownPoint.
  27.     "Assuming all lamp images are the same, get the first lamp image to use for
  28.      computation"
  29.     image := (model at: 1) getLampOffImage.
  30.     "Now iterate through each lamp in the model or until we find one that has been
  31.      clicked on."
  32.     1 to: (model size) do: [ :lampNumber | | lamp |
  33.         lamp := (model at: lampNumber).
  34.         "Compute the bounding box of this lamp's image in the view's coordinates."
  35.         box := Rectangle origin: (lamp position) extent: (image extent).
  36.         "Check if the pointer was on the image when the button was pressed."
  37.         (box containsPoint: mpt) ifTrue: [  "If so, then turn that lamp on."
  38.             ^lamp state: 1].        
  39.     ].!
  40.  
  41. processYellowButton
  42.  
  43.     (Dialog confirm: 'Quit ?') 
  44.         ifTrue: [view window controller closeAndUnschedule].! !
  45.  
  46. !LampController methodsFor: 'control defaults'!
  47.  
  48. controlActivity
  49.     "Do this when the mouse is in the window."
  50.  
  51.     (sensor keyboardPressed)
  52.         ifTrue: [ self processKeyboard]
  53.         ifFalse: [
  54.             sensor yellowButtonPressed
  55.             ifTrue: [ self processYellowButton].
  56.             sensor redButtonPressed
  57.             ifTrue: [ self processRedButton].
  58.         ].! !
  59.  
  60. Object subclass: #TrafficLight
  61.     instanceVariableNames: 'lamplist lampView '
  62.     classVariableNames: ''
  63.     poolDictionaries: ''
  64.     category: 'Examples-Lamps'!
  65.  
  66.  
  67. !TrafficLight methodsFor: 'initialization'!
  68.  
  69. initialize
  70.     "Creates the three lights and turns the first on"
  71.  
  72.     lamplist := LampList make:3.
  73.     lampView := LampView openOn: lamplist.
  74.     ^self.! !
  75.  
  76. !TrafficLight methodsFor: 'destruction'!
  77.  
  78. removeDependents
  79.     "Removes the dependents of each lamp in the TrafficLight"
  80.  
  81.     lamplist do: [:lamp | lamp release ].! !
  82.  
  83. !TrafficLight methodsFor: 'accessing'!
  84.  
  85. changeLight
  86.     "advances to the next light in the list"
  87.     | index |
  88.     Transcript show: 'Changing the Lights'; cr.
  89.     index := (self lightIsOn) id.
  90.     (lamplist at: (((index) rem: 3)) + 1) state: 1.
  91.     lampView update: lamplist.!
  92.  
  93. lamplist
  94.     "returns the lamplist"
  95.     ^lamplist.!
  96.  
  97. lightIsOn
  98.     "returns the index of the light that is on."
  99.  
  100.     ^(lamplist detect:
  101.         [ :lamp | lamp state = 1]).!
  102.  
  103. showStates
  104.     lamplist do: [ :lamp| lamp showState].! !
  105. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  106.  
  107. TrafficLight class
  108.     instanceVariableNames: ''!
  109.  
  110.  
  111. !TrafficLight class methodsFor: 'instance creation'!
  112.  
  113. new
  114.     "Creates a new instance and initializes the lights."
  115.  
  116.     ^(super new) initialize.! !
  117.  
  118. Model variableSubclass: #LampList
  119.     instanceVariableNames: 'numin theList '
  120.     classVariableNames: ''
  121.     poolDictionaries: ''
  122.     category: 'Examples-Lamps'!
  123.  
  124.  
  125. !LampList methodsFor: 'initialization'!
  126.  
  127. initialize
  128.     "Sets the count to zero."
  129.  
  130.     theList := OrderedCollection new.
  131.     numin := 0.! !
  132.  
  133. !LampList methodsFor: 'updating'!
  134.  
  135. update: signal
  136.     "Waits for all lamps to report in, then redraws the view."
  137.  
  138.     numin := numin + 1.
  139.     (numin = self size) ifTrue: [
  140.         numin := 0.
  141.         self changed.]! !
  142.  
  143. !LampList methodsFor: 'accessing'!
  144.  
  145. at: anInteger
  146.     "returns a Lamp for theList."
  147.     ^(theList at: anInteger).!
  148.  
  149. detect: aBlock
  150.     "Passes a detect message to theList"
  151.     ^(theList detect: aBlock).!
  152.  
  153. do: aBlock
  154.     "Tells theList to do aBlock."
  155.     ^(theList do: aBlock).!
  156.  
  157. numin
  158.     "Returns the count of how many updates from lamps have been received."
  159.  
  160.     ^numin!
  161.  
  162. numin: anInteger
  163.     "Sets the numin count to anInteger."
  164.  
  165.     numin := anInteger!
  166.  
  167. size
  168.     "Returns the size of theList."
  169.  
  170.     ^(theList size).! !
  171.  
  172. !LampList methodsFor: 'adding'!
  173.  
  174. add: aLamp
  175.     "Adds aLamp to theList."
  176.     theList add: aLamp.
  177.     ^theList.!
  178.  
  179. grow
  180.     "Override the normal system grow such that instance variables are
  181. preserved."
  182.  
  183.     | savednumin |
  184.  
  185.     savednumin := self numin.
  186.     super grow.
  187.     self numin: savednumin.!
  188.  
  189. growToAtLeast: anInteger
  190.     "Override the normal system growToAtLeast such that instance variables are
  191. preserved."
  192.  
  193.     | savednumin |
  194.  
  195.     savednumin := self numin.
  196.     super growToAtLeast: anInteger.
  197.     self numin: savednumin.! !
  198. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  199.  
  200. LampList class
  201.     instanceVariableNames: ''!
  202.  
  203.  
  204. !LampList class methodsFor: 'builder'!
  205.  
  206. make: anInteger
  207.     "Makes a lamp list with anInteger number of lamps input by the user."
  208.  
  209.     | lamplist lamp |
  210.     lamplist := LampList new: anInteger.
  211.     anInteger
  212.         timesRepeat:
  213.             [ lamp := Lamp new.
  214.               lamp position: 25 @ (lamplist size * 30).
  215.               lamp id: (lamplist size + 1).
  216.               lamp state: 0.
  217.               lamplist add: lamp.
  218.               lamp addDependent: lamplist].
  219.     1 to: lamplist size do: [ :l |
  220.         1 to: lamplist size do: [ :dep |
  221.             l = dep ifFalse: [
  222.                 (lamplist at: l) addDependent: (lamplist at: dep)]]].
  223.     ^lamplist! !
  224.  
  225. !LampList class methodsFor: 'instance creation'!
  226.  
  227. new
  228.     "Creates a new instance and initializes numin."
  229.  
  230.     ^super new initialize!
  231.  
  232. new: size
  233.     "Creates a new instance and initializes numin."
  234.  
  235.     ^(super new: size) initialize! !
  236.  
  237. Model subclass: #Lamp
  238.     instanceVariableNames: 'state position id '
  239.     classVariableNames: 'LampOffImage LampOnImage '
  240.     poolDictionaries: ''
  241.     category: 'Examples-Lamps'!
  242.  
  243.  
  244. !Lamp methodsFor: 'accessing'!
  245.  
  246. getLampOffImage
  247.     "Returns the image of the lamp in off state."
  248.  
  249.     ^LampOffImage!
  250.  
  251. getLampOnImage
  252.     "Returns the image of the lamp in on state."
  253.  
  254.     ^LampOnImage!
  255.  
  256. id
  257.     "Gets the id of the lamp"
  258.  
  259.     ^id.!
  260.  
  261. id: anInteger
  262.     "Sets the id of the lamp"
  263.  
  264.     id := anInteger.!
  265.  
  266. position
  267.     "Returns the position of the lamp."
  268.  
  269.     ^position.!
  270.  
  271. position: aPoint
  272.     "Sets the position of the lamp to aPoint."
  273.  
  274.     position := aPoint.!
  275.  
  276. showState
  277.     Transcript show: 'Lamp '; show: (id printString); show: ' state: '; show: (state printString); cr.!
  278.  
  279. state
  280.     "Returns the state of the lamp: 0=off, 1=on."
  281.  
  282.     ^state.!
  283.  
  284. state: anInteger
  285.     "Sets the state of the lamp: 0=off, 1=on."
  286.  
  287.     anInteger isZero ifFalse: [ state := 1.
  288.                                 self changed: #on]
  289.                       ifTrue: [ state := 0 ].! !
  290.  
  291. !Lamp methodsFor: 'updating'!
  292.  
  293. update: signal
  294.     "If some other lamp has turned on, turn myself off."
  295.  
  296.     (signal = #on)
  297.     ifTrue: [state := 0.
  298.               self changed].! !
  299. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  300.  
  301. Lamp class
  302.     instanceVariableNames: ''!
  303.  
  304.  
  305. !Lamp class methodsFor: 'instance creation'!
  306.  
  307. new
  308.     "Gets a new instance."
  309.  
  310.     ^super new! !
  311.  
  312. !Lamp class methodsFor: 'initialize-release'!
  313.  
  314. initialize
  315.     "Initialize class with an image."
  316.  
  317.     | bitPattern |
  318.  
  319.     bitPattern := #[
  320.             2r00001111 2r11110000
  321.             2r00110000 2r00001100
  322.             2r01000000 2r00000010
  323.             2r10000000 2r00000001
  324.             2r10000000 2r00000001
  325.             2r10000000 2r00000001
  326.             2r10000000 2r00000001
  327.             2r10000000 2r00000001
  328.             2r10000000 2r00000001
  329.             2r01000000 2r00000010
  330.             2r00100000 2r00000100
  331.             2r00010000 2r00001000
  332.             2r00001000 2r00010000
  333.             2r00000100 2r00100000
  334.             2r00000100 2r00100000
  335.             2r00000010 2r01000000
  336.             2r00000010 2r01000000
  337.             2r00000010 2r01000000
  338.             2r00000010 2r01000000
  339.             2r00000010 2r01000000 ].
  340.  
  341.     LampOnImage := Image
  342.         extent: 16@20
  343.         depth: 1
  344.         palette: MappedPalette blackWhite
  345.         bits: bitPattern
  346.         pad: 8.
  347.  
  348.         LampOffImage := Image
  349.         extent: 16@20
  350.         depth: 1
  351.         palette: MappedPalette whiteBlack
  352.         bits: bitPattern
  353.         pad: 8.! !
  354.  
  355. AutoScrollingView subclass: #LampView
  356.     instanceVariableNames: 'window '
  357.     classVariableNames: 'OpenFlag '
  358.     poolDictionaries: ''
  359.     category: 'Examples-Lamps'!
  360.  
  361.  
  362. !LampView methodsFor: 'displaying'!
  363.  
  364. displayObject
  365.     "Display the lamps in the window."
  366.  
  367.     | image lamp |
  368.     1 to: model size do:
  369.         [ :index | lamp := model at: index.
  370.             lamp state = 0 ifTrue: [ image := lamp getLampOffImage ]
  371.                               ifFalse: [ image := lamp getLampOnImage ].
  372.  
  373.         self graphicsContext displayImage: image at: lamp position.].!
  374.  
  375. displayOn: ingored
  376.     "Display the lamps in a window."
  377.  
  378.     self displayObject! !
  379.  
  380. !LampView methodsFor: 'updating'!
  381.  
  382. update: aModel
  383.     "The receiver's model has changed.  Redisplay the receiver."
  384.  
  385.     "(aModel = #done) ifTrue: [ self controller closeAndUnschedule ]
  386.         ifFalse: [OpenFlag ifTrue: ["self clearInside.
  387.             self displayObject"]]"! !
  388.  
  389. !LampView methodsFor: 'controller access'!
  390.  
  391. defaultControllerClass
  392.     "Answer the class of the default controller for the receiver."
  393.  
  394.     ^LampController.! !
  395.  
  396. !LampView methodsFor: 'accessing'!
  397.  
  398. window
  399.     "Returns the window that the view is displayed in."
  400.  
  401.     ^window!
  402.  
  403. window: aWindow
  404.     "Sets the window that the view is displayed in."
  405.  
  406.     window := aWindow! !
  407. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  408.  
  409. LampView class
  410.     instanceVariableNames: ''!
  411.  
  412.  
  413. !LampView class methodsFor: 'subview creation'!
  414.  
  415. getLampViewOn: aModel
  416.     "Get a view for the lamps."
  417.  
  418.     | view |
  419.     view := self new.
  420.     view model: aModel.
  421.     ^view! !
  422.  
  423. !LampView class methodsFor: 'instance creation'!
  424.  
  425. openOn: aLampList
  426.     "Creates a new Lamp View on aLampList."
  427.  
  428.     | view window |
  429.     OpenFlag := false.
  430.     view := self new.
  431.     view model: aLampList.
  432.  
  433.     window := ScheduledWindow new.
  434.     window label: 'Lamp Viewer'.
  435.     window minimumSize: 50@100.
  436.     window insideColor: (ColorValue red: 1.0 green: 0.0 blue: 0.0 ).
  437.     window component:  view.
  438.     view window: window.
  439.     window open.
  440.     ^view.! !
  441. Lamp initialize!
  442.  
  443.  
  444.