Smalltalk current createPackage: 'Examples' properties: #{}! Widget subclass: #Counter instanceVariableNames: 'count header' category: 'Examples'! !Counter methodsFor: 'actions'! increase count := count + 1. header contents: [:html | html with: count asString] ! decrease count := count - 1. header contents: [:html | html with: count asString] ! ! !Counter methodsFor: 'initialization'! initialize super initialize. count := 0 ! ! !Counter methodsFor: 'rendering'! renderOn: html header := html h1 with: count asString; yourself. html button with: '++'; onClick: [self increase]. html button with: '--'; onClick: [self decrease] ! ! Widget subclass: #Tetris instanceVariableNames: 'renderingContext timer speed score rows movingPiece' category: 'Examples'! !Tetris methodsFor: 'accessing'! width ^self class width ! height ^self class height ! squares ^self class squares ! gluePiece: aPiece aPiece glueOn: self ! rows "An array of rows. Each row is a collection of points." ^rows ! addRow: aCollection self rows add: aCollection ! ! !Tetris methodsFor: 'actions'! startNewGame self newGame. timer ifNotNil: [timer clearInterval]. timer := [self nextStep] valueWithInterval: speed ! nextStep movingPiece ifNil: [self newPiece]. (movingPiece canMoveIn: self) ifTrue: [movingPiece position: movingPiece position + (0@1)] ifFalse: [self newPiece]. self redraw ! redraw renderingContext clearRect: 0 y: self width to: 0 y: self height. self drawMap; drawPiece ! drawMap renderingContext fillStyle: '#fafafa'; fillRect: 0 y: 0 to: self width y: self height. renderingContext lineWidth: 0.5; strokeStyle: '#999'. 0 to: self class squares x do: [:each | | x | x := each * self class squareSize. self drawLineFrom: x@0 to: x@self height]. 0 to: self class squares y do: [:each | | y | y := each * self class squareSize. self drawLineFrom: 0@y to: self width@y]. ! drawLineFrom: aPoint to: anotherPoint renderingContext beginPath; moveTo: aPoint x y: aPoint y; lineTo: anotherPoint x y: anotherPoint y; stroke ! newGame rows := #(). movingPiece := nil. speed := 200. score := 0 ! newPiece movingPiece := TetrisPiece atRandom ! drawRows self rows do: [:each |]. movingPiece ifNotNil: [movingPiece drawOn: renderingContext] ! drawPiece movingPiece ifNotNil: [ movingPiece drawOn: renderingContext] ! ! !Tetris methodsFor: 'initialization'! initialize super initialize. self newGame ! ! !Tetris methodsFor: 'rendering'! renderOn: html html div class: 'tetris'; with: [ html h3 with: 'Tetris'. self renderCanvasOn: html. self renderButtonsOn: html] ! renderCanvasOn: html | canvas | canvas := html canvas. canvas at: 'width' put: self width asString. canvas at: 'height' put: self height asString. renderingContext := canvas element getContext: '2d'. self redraw ! renderButtonsOn: html html div class: 'tetris_buttons'; with: [ html button with: 'New game'; onClick: [self startNewGame]. html button with: 'play/pause'; onClick: []] ! ! !Tetris class methodsFor: 'accessing'! squareSize ^22 ! width ^self squareSize * (self squares x) ! height ^self squareSize * (self squares y) ! squares ^10@15 ! ! Widget subclass: #TetrisPiece instanceVariableNames: 'rotation position' category: 'Examples'! !TetrisPiece methodsFor: 'accessing'! rotation ^rotation ifNil: [rotation := 1] ! rotation: aNumber rotation := aNumber ! position ^position ifNil: [(Tetris squares x / 2) -1 @ 0] ! position: aPoint ^position := aPoint ! bounds self subclassResponsibility ! color ^'#afa' ! height ^2 ! ! !TetrisPiece methodsFor: 'drawing'! drawOn: aRenderingContext aRenderingContext fillStyle: self color. self bounds do: [:each || from to | from := each + self position* Tetris squareSize. to := 1@1 * Tetris squareSize. aRenderingContext fillRect: from x y: from y to: to x y: to y; strokeStyle: '#999'; lineWidth: 2; strokeRect: from x y: from y to: to x y: to y] ! ! !TetrisPiece methodsFor: 'testing'! canMove ^self position y < (Tetris squares y - self height) ! canMoveIn: aTetris ^self position y < (aTetris squares y - self height) ! ! !TetrisPiece class methodsFor: 'instance creation'! atRandom ^(self subclasses at: self subclasses size atRandom) new ! ! TetrisPiece subclass: #TetrisPieceO instanceVariableNames: '' category: 'Examples'! !TetrisPieceO methodsFor: 'accessing'! bounds ^Array new add: 0@0; add: 0@1; add: 1@0; add: 1@1; yourself ! ! TetrisPiece subclass: #TetrisPieceL instanceVariableNames: '' category: 'Examples'! !TetrisPieceL methodsFor: 'accessing'! bounds ^Array new add: 0@0; add: 0@1; add: 0@2; add: 1@2; yourself ! color ^'#ffa' ! height ^3 ! ! TetrisPiece subclass: #TetrisPieceJ instanceVariableNames: '' category: 'Examples'! !TetrisPieceJ methodsFor: 'accessing'! color ^'#aaf' ! bounds ^Array new add: 1@0; add: 1@1; add: 1@2; add: 0@2; yourself ! height ^3 ! ! TetrisPiece subclass: #TetrisPieceI instanceVariableNames: '' category: 'Examples'! !TetrisPieceI methodsFor: 'accessing'! color ^'#faa' ! bounds ^Array new add: 0@0; add: 0@1; add: 0@2; add: 0@3; yourself ! height ^4 ! ! TetrisPiece subclass: #TetrisPieceT instanceVariableNames: '' category: 'Examples'! !TetrisPieceT methodsFor: 'accessing'! bounds ^Array new add: 0@0; add: 1@0; add: 2@0; add: 1@1; yourself ! color ^'#aaf' ! !