2
0

Examples.st 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359
  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 clearRect: 0 y: self width to: 0 y: self height.
  68. self
  69. drawMap;
  70. drawPiece
  71. !
  72. drawMap
  73. renderingContext
  74. fillStyle: '#fafafa';
  75. fillRect: 0 y: 0 to: self width y: 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 x y: aPoint y;
  90. lineTo: anotherPoint x y: anotherPoint y;
  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 := canvas element getContext: '2d'.
  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: []]
  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 || from to |
  185. from := each + self position* Tetris squareSize.
  186. to := 1@1 * Tetris squareSize.
  187. aRenderingContext
  188. fillRect: from x y: from y to: to x y: to y;
  189. strokeStyle: '#999';
  190. lineWidth: 2;
  191. strokeRect: from x y: from y to: to x y: to y]
  192. ! !
  193. !TetrisPiece methodsFor: 'testing'!
  194. canMove
  195. ^self position y < (Tetris squares y - self height)
  196. !
  197. canMoveIn: aTetris
  198. ^self position y < (aTetris squares y - self height)
  199. ! !
  200. !TetrisPiece class methodsFor: 'instance creation'!
  201. atRandom
  202. ^(self subclasses at: self subclasses size atRandom) new
  203. ! !
  204. TetrisPiece subclass: #TetrisPieceO
  205. instanceVariableNames: ''
  206. category: 'Examples'!
  207. !TetrisPieceO methodsFor: 'accessing'!
  208. bounds
  209. ^Array new
  210. add: 0@0;
  211. add: 0@1;
  212. add: 1@0;
  213. add: 1@1;
  214. yourself
  215. ! !
  216. TetrisPiece subclass: #TetrisPieceL
  217. instanceVariableNames: ''
  218. category: 'Examples'!
  219. !TetrisPieceL methodsFor: 'accessing'!
  220. bounds
  221. ^Array new
  222. add: 0@0;
  223. add: 0@1;
  224. add: 0@2;
  225. add: 1@2;
  226. yourself
  227. !
  228. color
  229. ^'#ffa'
  230. !
  231. height
  232. ^3
  233. ! !
  234. TetrisPiece subclass: #TetrisPieceJ
  235. instanceVariableNames: ''
  236. category: 'Examples'!
  237. !TetrisPieceJ methodsFor: 'accessing'!
  238. color
  239. ^'#aaf'
  240. !
  241. bounds
  242. ^Array new
  243. add: 1@0;
  244. add: 1@1;
  245. add: 1@2;
  246. add: 0@2;
  247. yourself
  248. !
  249. height
  250. ^3
  251. ! !
  252. TetrisPiece subclass: #TetrisPieceI
  253. instanceVariableNames: ''
  254. category: 'Examples'!
  255. !TetrisPieceI methodsFor: 'accessing'!
  256. color
  257. ^'#faa'
  258. !
  259. bounds
  260. ^Array new
  261. add: 0@0;
  262. add: 0@1;
  263. add: 0@2;
  264. add: 0@3;
  265. yourself
  266. !
  267. height
  268. ^4
  269. ! !
  270. TetrisPiece subclass: #TetrisPieceT
  271. instanceVariableNames: ''
  272. category: 'Examples'!
  273. !TetrisPieceT methodsFor: 'accessing'!
  274. bounds
  275. ^Array new
  276. add: 0@0;
  277. add: 1@0;
  278. add: 2@0;
  279. add: 1@1;
  280. yourself
  281. !
  282. color
  283. ^'#aaf'
  284. ! !