1
0

Examples.st 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357
  1. Widget subclass: #Counter
  2. instanceVariableNames: 'count header'
  3. category: 'Examples'!
  4. !Counter methodsFor: 'actions'!
  5. increase
  6. count := count + 1.
  7. header contents: [:html | html with: count asString]
  8. !
  9. decrease
  10. count := count - 1.
  11. header contents: [:html | html with: count asString]
  12. ! !
  13. !Counter methodsFor: 'initialization'!
  14. initialize
  15. super initialize.
  16. count := 0
  17. ! !
  18. !Counter methodsFor: 'rendering'!
  19. renderOn: html
  20. header := html h1
  21. with: count asString;
  22. yourself.
  23. html button
  24. with: '++';
  25. onClick: [self increase].
  26. html button
  27. with: '--';
  28. onClick: [self decrease]
  29. ! !
  30. Widget subclass: #Tetris
  31. instanceVariableNames: 'renderingContext timer speed score rows movingPiece'
  32. category: 'Examples'!
  33. !Tetris methodsFor: 'accessing'!
  34. width
  35. ^self class width
  36. !
  37. height
  38. ^self class height
  39. !
  40. squares
  41. ^self class squares
  42. !
  43. gluePiece: aPiece
  44. aPiece glueOn: self
  45. !
  46. rows
  47. "An array of rows. Each row is a collection of points."
  48. ^rows
  49. !
  50. addRow: aCollection
  51. self rows add: aCollection
  52. ! !
  53. !Tetris methodsFor: 'actions'!
  54. startNewGame
  55. self newGame.
  56. timer ifNotNil: [timer clearInterval].
  57. timer := [self nextStep] valueWithInterval: speed
  58. !
  59. nextStep
  60. movingPiece ifNil: [self newPiece].
  61. (movingPiece canMoveIn: self)
  62. ifTrue: [movingPiece position: movingPiece position + (0@1)]
  63. ifFalse: [self newPiece].
  64. self redraw
  65. !
  66. redraw
  67. renderingContext clearRectFrom: 0@ self width to: 0@ self height.
  68. self
  69. drawMap;
  70. drawPiece
  71. !
  72. drawMap
  73. renderingContext
  74. fillStyle: '#fafafa';
  75. fillRectFrom: 0@0 to: self width@self height.
  76. renderingContext
  77. lineWidth: 0.5;
  78. strokeStyle: '#999'.
  79. 0 to: self class squares x do: [:each | | x |
  80. x := each * self class squareSize.
  81. self drawLineFrom: x@0 to: x@self height].
  82. 0 to: self class squares y do: [:each | | y |
  83. y := each * self class squareSize.
  84. self drawLineFrom: 0@y to: self width@y].
  85. !
  86. drawLineFrom: aPoint to: anotherPoint
  87. renderingContext
  88. beginPath;
  89. moveTo: aPoint;
  90. lineTo: anotherPoint;
  91. stroke
  92. !
  93. newGame
  94. rows := #().
  95. movingPiece := nil.
  96. speed := 200.
  97. score := 0
  98. !
  99. newPiece
  100. movingPiece := TetrisPiece atRandom
  101. !
  102. drawRows
  103. self rows do: [:each |].
  104. movingPiece ifNotNil: [movingPiece drawOn: renderingContext]
  105. !
  106. drawPiece
  107. movingPiece ifNotNil: [
  108. movingPiece drawOn: renderingContext]
  109. ! !
  110. !Tetris methodsFor: 'initialization'!
  111. initialize
  112. super initialize.
  113. self newGame
  114. ! !
  115. !Tetris methodsFor: 'rendering'!
  116. renderOn: html
  117. html div
  118. class: 'tetris';
  119. with: [
  120. html h3 with: 'Tetris'.
  121. self renderCanvasOn: html.
  122. self renderButtonsOn: html]
  123. !
  124. renderCanvasOn: html
  125. | canvas |
  126. canvas := html canvas.
  127. canvas at: 'width' put: self width asString.
  128. canvas at: 'height' put: self height asString.
  129. renderingContext := CanvasRenderingContext tagBrush: canvas.
  130. self redraw
  131. !
  132. renderButtonsOn: html
  133. html div
  134. class: 'tetris_buttons';
  135. with: [
  136. html button
  137. with: 'New game';
  138. onClick: [self startNewGame].
  139. html button
  140. with: 'play/pause';
  141. onClick: [self update]]
  142. ! !
  143. !Tetris class methodsFor: 'accessing'!
  144. squareSize
  145. ^22
  146. !
  147. width
  148. ^self squareSize * (self squares x)
  149. !
  150. height
  151. ^self squareSize * (self squares y)
  152. !
  153. squares
  154. ^10@15
  155. ! !
  156. Widget subclass: #TetrisPiece
  157. instanceVariableNames: 'rotation position'
  158. category: 'Examples'!
  159. !TetrisPiece methodsFor: 'accessing'!
  160. rotation
  161. ^rotation ifNil: [rotation := 1]
  162. !
  163. rotation: aNumber
  164. rotation := aNumber
  165. !
  166. position
  167. ^position ifNil: [(Tetris squares x / 2) -1 @ 0]
  168. !
  169. position: aPoint
  170. ^position := aPoint
  171. !
  172. bounds
  173. self subclassResponsibility
  174. !
  175. color
  176. ^'#afa'
  177. !
  178. height
  179. ^2
  180. ! !
  181. !TetrisPiece methodsFor: 'drawing'!
  182. drawOn: aRenderingContext
  183. aRenderingContext fillStyle: self color.
  184. self bounds do: [:each |
  185. aRenderingContext
  186. fillRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize;
  187. strokeStyle: '#999';
  188. lineWidth: 2;
  189. strokeRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize]
  190. ! !
  191. !TetrisPiece methodsFor: 'testing'!
  192. canMove
  193. ^self position y < (Tetris squares y - self height)
  194. !
  195. canMoveIn: aTetris
  196. ^self position y < (aTetris squares y - self height)
  197. ! !
  198. !TetrisPiece class methodsFor: 'instance creation'!
  199. atRandom
  200. ^(self subclasses at: self subclasses size atRandom) new
  201. ! !
  202. TetrisPiece subclass: #TetrisPieceO
  203. instanceVariableNames: ''
  204. category: 'Examples'!
  205. !TetrisPieceO methodsFor: 'accessing'!
  206. bounds
  207. ^Array new
  208. add: 0@0;
  209. add: 0@1;
  210. add: 1@0;
  211. add: 1@1;
  212. yourself
  213. ! !
  214. TetrisPiece subclass: #TetrisPieceL
  215. instanceVariableNames: ''
  216. category: 'Examples'!
  217. !TetrisPieceL methodsFor: 'accessing'!
  218. bounds
  219. ^Array new
  220. add: 0@0;
  221. add: 0@1;
  222. add: 0@2;
  223. add: 1@2;
  224. yourself
  225. !
  226. color
  227. ^'#ffa'
  228. !
  229. height
  230. ^3
  231. ! !
  232. TetrisPiece subclass: #TetrisPieceJ
  233. instanceVariableNames: ''
  234. category: 'Examples'!
  235. !TetrisPieceJ methodsFor: 'accessing'!
  236. color
  237. ^'#aaf'
  238. !
  239. bounds
  240. ^Array new
  241. add: 1@0;
  242. add: 1@1;
  243. add: 1@2;
  244. add: 0@2;
  245. yourself
  246. !
  247. height
  248. ^3
  249. ! !
  250. TetrisPiece subclass: #TetrisPieceI
  251. instanceVariableNames: ''
  252. category: 'Examples'!
  253. !TetrisPieceI methodsFor: 'accessing'!
  254. color
  255. ^'#faa'
  256. !
  257. bounds
  258. ^Array new
  259. add: 0@0;
  260. add: 0@1;
  261. add: 0@2;
  262. add: 0@3;
  263. yourself
  264. !
  265. height
  266. ^4
  267. ! !
  268. TetrisPiece subclass: #TetrisPieceT
  269. instanceVariableNames: ''
  270. category: 'Examples'!
  271. !TetrisPieceT methodsFor: 'accessing'!
  272. bounds
  273. ^Array new
  274. add: 0@0;
  275. add: 1@0;
  276. add: 2@0;
  277. add: 1@1;
  278. yourself
  279. !
  280. color
  281. ^'#aaf'
  282. ! !