1
0

Examples.st 5.5 KB

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