home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP22.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  12KB  |  470 lines
  1.  
  2. 'Smalltalk Textbook Appendix 22'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. Model subclass: #EngiPuzzleModel
  9.     instanceVariableNames: 'puzzleGrid puzzleImage puzzleBoard '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Puzzle'!
  13. EngiPuzzleModel comment:
  14. '
  15.  
  16. Engi 0.06 (19 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiPuzzleModel methodsFor: 'accessing'!
  23.  
  24. pointAt: aPoint 
  25.     (self containsPoint: aPoint)
  26.         ifTrue: [^(puzzleBoard at: aPoint y)
  27.                 at: aPoint x].
  28.     ^nil!
  29.  
  30. pointAt: aPoint put: stoneNumber 
  31.     (self containsPoint: aPoint)
  32.         ifTrue: [(puzzleBoard at: aPoint y)
  33.                 at: aPoint x put: stoneNumber]!
  34.  
  35. puzzleGrid
  36.     ^puzzleGrid!
  37.  
  38. puzzleGridSize
  39.     ^self puzzleGridX * self puzzleGridY!
  40.  
  41. puzzleGridX
  42.     ^self puzzleGrid x!
  43.  
  44. puzzleGridY
  45.     ^self puzzleGrid y!
  46.  
  47. puzzleImage
  48.     ^puzzleImage!
  49.  
  50. stoneHeight
  51.     ^(self puzzleImage height // self puzzleGridY) rounded!
  52.  
  53. stoneWidth
  54.     ^(self puzzleImage width // self puzzleGridX) rounded! !
  55.  
  56. !EngiPuzzleModel methodsFor: 'testing'!
  57.  
  58. containsPoint: aPoint 
  59.     ^((1 to: self puzzleGridX)
  60.         includes: aPoint x)
  61.         and: [(1 to: self puzzleGridY)
  62.                 includes: aPoint y]!
  63.  
  64. isPerfect
  65.     | stoneNumber |
  66.     stoneNumber := 1.
  67.     1 to: self puzzleGridY do: [:y | 1 to: self puzzleGridX
  68.             do: 
  69.                 [:x | 
  70.                 stoneNumber = (self pointAt: x @ y) ifFalse: [^false].
  71.                 stoneNumber := stoneNumber + 1]].
  72.     ^true!
  73.  
  74. whereIsBlank
  75.     | stoneNumber |
  76.     1 to: self puzzleGridY do: [:y | 1 to: self puzzleGridX
  77.             do: 
  78.                 [:x | 
  79.                 stoneNumber := self pointAt: x @ y.
  80.                 self puzzleGridSize = stoneNumber ifTrue: [^x @ y]]].
  81.     ^self puzzleGridSize!
  82.  
  83. wherePoint: aPoint 
  84.     ^aPoint x // self stoneWidth + 1 @ (aPoint y // self stoneHeight + 1)! !
  85.  
  86. !EngiPuzzleModel methodsFor: 'moving'!
  87.  
  88. movePoints: aPoint 
  89.     | collection point |
  90.     (self containsPoint: aPoint)
  91.         ifFalse: [^OrderedCollection new].
  92.     collection := OrderedCollection new.
  93.     aPoint x
  94.         to: self puzzleGridX
  95.         by: 1
  96.         do: 
  97.             [:x | 
  98.             point := x @ aPoint y.
  99.             collection add: point.
  100.             (self pointAt: point)
  101.                 = self puzzleGridSize ifTrue: [^collection]].
  102.     collection := OrderedCollection new.
  103.     aPoint x
  104.         to: 1
  105.         by: -1
  106.         do: 
  107.             [:x | 
  108.             point := x @ aPoint y.
  109.             collection add: point.
  110.             (self pointAt: point)
  111.                 = self puzzleGridSize ifTrue: [^collection]].
  112.     collection := OrderedCollection new.
  113.     aPoint y
  114.         to: self puzzleGridY
  115.         by: 1
  116.         do: 
  117.             [:y | 
  118.             point := aPoint x @ y.
  119.             collection add: point.
  120.             (self pointAt: point)
  121.                 = self puzzleGridSize ifTrue: [^collection]].
  122.     collection := OrderedCollection new.
  123.     aPoint y
  124.         to: 1
  125.         by: -1
  126.         do: 
  127.             [:y | 
  128.             point := aPoint x @ y.
  129.             collection add: point.
  130.             (self pointAt: point)
  131.                 = self puzzleGridSize ifTrue: [^collection]].
  132.     collection := OrderedCollection new.
  133.     ^collection!
  134.  
  135. moveStone: aPoint 
  136.     | movePoints srcPoints dstPoints srcPoint dstPoint |
  137.     movePoints := self movePoints: aPoint.
  138.     movePoints isEmpty ifTrue: [^self].
  139.     srcPoints := movePoints reverse.
  140.     srcPoints removeFirst.
  141.     dstPoints := movePoints reverse.
  142.     dstPoints removeLast.
  143.     1 to: srcPoints size
  144.         do: 
  145.             [:index | 
  146.             srcPoint := srcPoints at: index.
  147.             dstPoint := dstPoints at: index.
  148.             self moveStone: srcPoint to: dstPoint].
  149.     (srcPoints isEmpty not and: [self isPerfect])
  150.         ifTrue: [(Screen default) ringBell; ringBell; ringBell]!
  151.  
  152. moveStone: srcPoint to: dstPoint 
  153.     self pointAt: dstPoint put: (self pointAt: srcPoint).
  154.     self changed: dstPoint.
  155.     self pointAt: srcPoint put: self puzzleGridSize.
  156.     self changed: srcPoint! !
  157.  
  158. !EngiPuzzleModel methodsFor: 'menu messages'!
  159.  
  160. normalize
  161.     | stoneNumber |
  162.     stoneNumber := 1.
  163.     1 to: self puzzleGridY do: [:y | 1 to: self puzzleGridX
  164.             do: 
  165.                 [:x | 
  166.                 self pointAt: x @ y put: stoneNumber.
  167.                 stoneNumber := stoneNumber + 1]].
  168.     self changed!
  169.  
  170. randomize
  171.     | set collection random number index |
  172.     set := Set new.
  173.     collection := OrderedCollection new.
  174.     random := Random new.
  175.     [collection size < self puzzleGridSize]
  176.         whileTrue: 
  177.             [number := (random next * self puzzleGridSize + 1) truncated.
  178.             (set includes: number) not
  179.                 ifTrue: 
  180.                     [set add: number.
  181.                     collection add: number]].
  182.     index := 1.
  183.     1 to: self puzzleGridY do: [:y | 1 to: self puzzleGridX
  184.             do: 
  185.                 [:x | 
  186.                 self pointAt: x @ y put: (collection at: index).
  187.                 index := index + 1]].
  188.     self changed! !
  189.  
  190. !EngiPuzzleModel methodsFor: 'private'!
  191.  
  192. grid: gridPoint image: anImage 
  193.     | aPixmap aBlock graphicsContext aPoint |
  194.     puzzleGrid := gridPoint.
  195.     puzzleBoard := Array new: self puzzleGridY.
  196.     1 to: puzzleBoard size do: [:index | puzzleBoard at: index put: (Array new: self puzzleGridX)].
  197.     aPixmap := Pixmap extent: (anImage extent truncateTo: self puzzleGrid).
  198.     aBlock := 
  199.             [graphicsContext := aPixmap graphicsContext.
  200.             aPoint := aPixmap bounds center - anImage bounds center.
  201.             anImage displayOn: graphicsContext at: aPoint.
  202.             puzzleImage := aPixmap asImage].
  203.     [aBlock value]
  204.         valueNowOrOnUnwindDo: [aPixmap close].
  205.     self randomize.
  206.     ^self! !
  207. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  208.  
  209. EngiPuzzleModel class
  210.     instanceVariableNames: ''!
  211.  
  212.  
  213. !EngiPuzzleModel class methodsFor: 'instance creation'!
  214.  
  215. grid: gridPoint 
  216.     ^self grid: gridPoint image: (self defaultPuzzleImage: gridPoint)!
  217.  
  218. grid: gridPoint image: anImage 
  219.     ^super new grid: gridPoint image: anImage!
  220.  
  221. new
  222.     ^self grid: self defaultPuzzleGrid image: (self defaultPuzzleImage: self defaultPuzzleGrid)! !
  223.  
  224. !EngiPuzzleModel class methodsFor: 'defaults'!
  225.  
  226. defaultPuzzleGrid
  227.     ^4 @ 4!
  228.  
  229. defaultPuzzleImage: grid 
  230.     | extent stone stones |
  231.     extent := self defaultStoneExtent.
  232.     stone := 
  233.             [:index | 
  234.             | pixmap gc paragraph point rect image |
  235.             pixmap := Pixmap extent: extent.
  236.             [gc := pixmap graphicsContext.
  237.             index = (grid x * grid y)
  238.                 ifTrue: 
  239.                     [pixmap background: (ColorValue brightness: 1).
  240.                     pixmap clear]
  241.                 ifFalse: 
  242.                     [pixmap background: (ColorValue brightness: 0.5).
  243.                     pixmap clear.
  244.                     paragraph := index printString asComposedText.
  245.                     point := pixmap bounds center - paragraph bounds center.
  246.                     gc paint: (ColorValue brightness: 1).
  247.                     paragraph displayOn: gc at: point + (-1 @ -1).
  248.                     paragraph displayOn: gc at: point + (-1 @ 0).
  249.                     paragraph displayOn: gc at: point + (-1 @ 1).
  250.                     paragraph displayOn: gc at: point + (0 @ -1).
  251.                     paragraph displayOn: gc at: point + (0 @ 1).
  252.                     paragraph displayOn: gc at: point + (1 @ -1).
  253.                     paragraph displayOn: gc at: point + (1 @ 0).
  254.                     paragraph displayOn: gc at: point + (1 @ 1).
  255.                     gc paint: (ColorValue brightness: 0).
  256.                     paragraph displayOn: gc at: point.
  257.                     rect := 0 @ 0 extent: extent - (1 @ 1).
  258.                     gc paint: (ColorValue brightness: 0.25).
  259.                     gc displayLineFrom: rect bottomLeft to: rect bottomRight.
  260.                     gc displayLineFrom: rect topRight to: rect bottomRight.
  261.                     gc paint: (ColorValue brightness: 0.75).
  262.                     gc displayLineFrom: rect topLeft to: rect topRight.
  263.                     gc displayLineFrom: rect topLeft to: rect bottomLeft].
  264.             image := pixmap asImage]
  265.                 valueNowOrOnUnwindDo: [pixmap close].
  266.             image].
  267.     stones := 
  268.             [| pixmap gc index image point |
  269.             pixmap := Pixmap extent: grid * extent.
  270.             [gc := pixmap graphicsContext.
  271.             index := 1.
  272.             1 to: grid y do: [:j | 1 to: grid x
  273.                     do: 
  274.                         [:i | 
  275.                         image := stone value: index.
  276.                         point := i - 1 * extent x @ (j - 1 * extent y).
  277.                         image displayOn: gc at: point.
  278.                         index := index + 1]].
  279.             image := pixmap asImage]
  280.                 valueNowOrOnUnwindDo: [pixmap close].
  281.             image].
  282.     ^stones value!
  283.  
  284. defaultStoneExtent
  285.     ^35 @ 35! !
  286.  
  287. !EngiPuzzleModel class methodsFor: 'examples'!
  288.  
  289. example1
  290.     "EngiPuzzleModel example1."
  291.  
  292.     | puzzleModel |
  293.     puzzleModel := EngiPuzzleModel new.
  294.     EngiPuzzleView openOn: puzzleModel.
  295.     ^puzzleModel!
  296.  
  297. example2
  298.     "EngiPuzzleModel example2."
  299.  
  300.     | puzzleModel |
  301.     puzzleModel := EngiPuzzleModel grid: 3 @ 3.
  302.     EngiPuzzleView openOn: puzzleModel.
  303.     ^puzzleModel!
  304.  
  305. example3
  306.     "EngiPuzzleModel example3."
  307.  
  308.     | puzzleModel |
  309.     puzzleModel := EngiPuzzleModel grid: 3 @ 3 image: Image fromUser.
  310.     EngiPuzzleView openOn: puzzleModel.
  311.     ^puzzleModel!
  312.  
  313. example4
  314.     "EngiPuzzleModel example4."
  315.  
  316.     | puzzleModel |
  317.     puzzleModel := EngiPuzzleModel new.
  318.     EngiPuzzleView openOn: puzzleModel.
  319.     EngiPuzzleView openOn: puzzleModel.
  320.     puzzleModel normalize.
  321.     (Delay forSeconds: 1) wait.
  322.     puzzleModel moveStone: 3 @ 4.
  323.     (Delay forSeconds: