view src/Serpentron.st @ 15:7811c5ea0700

Serpentron 1.0.1.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 12 Apr 2016 23:43:13 +0300
parents 89fc4ef53637
children 4943c163d0b4
line source
1 Smalltalk createPackage: 'Serpentron'!
2 (Smalltalk packageAt: 'Serpentron') imports: {'silk/Silk'}!
3 Object subclass: #Serpentron
4 instanceVariableNames: 'field skin players playerColors controllerPrototypes score pointsToWin timeoutId startScreenVisible'
5 package: 'Serpentron'!
6 !Serpentron commentStamp!
7 The game UI.!
9 !Serpentron methodsFor: 'initialization'!
11 initialize
12 super initialize.
13 playerColors := #('#e41a1c' '#377eb8' '#4daf4a' '#ff7f00' '#984ea3' '#b3ad78').
14 startScreenVisible := true.
15 skin := TronSkin new.
16 field := TronField new
17 skin: skin;
18 onEndGame: [ self handleEndGame ].
19 self initializePlayers; initializeControllers.
20 (Silk fromElement: document)
21 on: #keydown bind: [ :event | self keyDown: event ].
22 ! !
24 !Serpentron methodsFor: 'private'!
26 handleEndGame
27 | color |
28 field isGameFinished
29 "Interrupted game, no winner."
30 ifFalse: [ ^ self startScreenVisible: true ].
31 color := field winningColorIfNone: [
32 ^ self status: 'No winner in this round.'; nextRound ].
33 self updateScore.
34 (score anySatisfy: [ :each | each >= pointsToWin ])
35 ifFalse: [
36 self
37 status: (self winnerDOM: color) << ' won the round.';
38 nextRound.
39 ^ self ].
40 self status: self scoreDOM.
41 timeoutId := window
42 setTimeout: [ self showGameWinner: color ]
43 after: 1000.
44 !
46 hideMessage
47 (Silk at: '#message') element className: 'hidden'.
48 !
50 initializeControllers
51 controllerPrototypes := {
52 TronKeyboardController new
53 keyMap: #{
54 38 -> (0 @ -1).
55 39 -> (1 @ 0).
56 40 -> (0 @ 1).
57 37 -> (-1 @ 0)}
58 name: 'arrows'.
59 TronKeyboardController new
60 keyMap: #{
61 87 -> (0 @ -1).
62 68 -> (1 @ 0).
63 83 -> (0 @ 1).
64 65 -> (-1 @ 0)}
65 name: 'WASD'.
66 TronKeyboardController new
67 keyMap: #{
68 89 -> (0 @ -1).
69 74 -> (1 @ 0).
70 72 -> (0 @ 1).
71 71 -> (-1 @ 0)}
72 name: 'YGHJ'.
73 TronKeyboardController new
74 keyMap: #{
75 80 -> (0 @ -1).
76 222 -> (1 @ 0).
77 59 -> (0 @ 1).
78 76 -> (-1 @ 0)}
79 name: 'PL;'''.
80 TronComputerController1 new.
81 "TronRandomController new"
82 }.
83 (players at: 1) controller: (controllerPrototypes at: 5) copy.
84 (players at: 2) controller: (controllerPrototypes at: 1) copy.
85 (players at: 3) controller: (controllerPrototypes at: 5) copy.
86 (players at: 4) controller: (controllerPrototypes at: 5) copy.
87 !
89 initializePlayers
90 players := {
91 TronPlayer new
92 name: 'Player 1';
93 color: (playerColors at: 1).
94 TronPlayer new
95 name: 'Player 2';
96 color: (playerColors at: 2).
97 TronPlayer new
98 name: 'Player 3';
99 color: (playerColors at: 3);
100 enabled: false.
101 TronPlayer new
102 name: 'Player 4';
103 color: (playerColors at: 4);
104 enabled: false
105 }.
106 !
108 keyDown: event
109 startScreenVisible ifTrue: [ ^ self ].
110 "Handle Esc key."
111 (event keyCode = 27)
112 ifTrue: [
113 event preventDefault.
114 field stopTimer.
115 window clearTimeout: timeoutId.
116 self hideMessage; startScreenVisible: true.
117 ^ self ].
118 field keyDown: event.
119 !
121 nextRound
122 timeoutId := window
123 setTimeout: [
124 self status: self scoreDOM.
125 field start: field players ]
126 after: 2000.
127 !
129 randomizePlayerColors
130 | enabledPlayers |
131 enabledPlayers := players select: #isEnabled.
132 enabledPlayers do: [ :each |
133 | color |
134 [ color := playerColors atRandom.
135 enabledPlayers allSatisfy: [ :p |
136 p = each | (p color ~= color) ]
137 ] whileFalse.
138 each color: color.
139 ].
140 !
142 randomizeTeams
143 | colorA colorB teamA |
144 players do: [ :each | each enabled: true ].
145 colorA := playerColors atRandom.
146 [ colorB := playerColors atRandom.
147 colorB = colorA ] whileTrue.
148 teamA := players copy.
149 players size // 2
150 timesRepeat: [ (teamA remove: teamA atRandom) color: colorB ].
151 teamA do: [ :each | each color: colorA ].
152 !
154 renderColorSelectorFor: aPlayer on: aSilk
155 | container buttons onChange |
156 container := aSilk SPAN: {#class -> 'color-selector'}.
157 buttons := Dictionary from:
158 (playerColors collect: [ :each |
159 | button |
160 button := container A.
161 button on: #click bind: [
162 aPlayer enabled: true; color: each.
163 self validatePlayerColor: aPlayer ].
164 button element style background: each.
165 each -> button ]).
166 buttons at: #disabled put: (container A
167 SPAN: '✗';
168 on: #click bind: [
169 aPlayer enabled: false.
170 self validatePlayerColor: aPlayer ]).
171 onChange := [
172 buttons keysAndValuesDo: [ :k :v |
173 (aPlayer isEnabled not & k = #disabled) |
174 (aPlayer isEnabled & k = aPlayer color)
175 ifTrue: [ v element className: 'selected-color-button' ]
176 ifFalse: [ v element className: 'color-button' ] ] ].
177 aPlayer
178 onEnabledChange: onChange;
179 onColorChange: onChange.
180 onChange value.
181 !
183 renderControllerSelectorFor: aPlayer on: aSilk
184 | select options onChange |
185 select := aSilk SELECT.
186 options := Dictionary new.
187 controllerPrototypes do: [ :each |
188 options at: each name put: (select OPTION: each name) element ].
189 select
190 on: #change
191 bind: [
192 aPlayer controller:
193 (controllerPrototypes
194 detect: [ :each | each name = select element value ])
195 copy ].
196 onChange := [
197 | value |
198 value := aPlayer controller name.
199 (options at: value) selected: 'selected'.
200 aPlayer controller class = TronKeyboardController
201 ifTrue: [
202 players do: [ :each |
203 (each ~= aPlayer and: [ each controller name = value ])
204 ifTrue: [ each controller: TronComputerController1 new ]]]].
205 aPlayer onControllerChange: onChange.
206 onChange value.
207 !
209 renderPlayer: aPlayer on: aSilk
210 | container |
211 container := aSilk DIV: { #class -> 'player' }.
212 self renderColorSelectorFor: aPlayer on: container.
213 (container INPUT
214 on: #change bind: [ :event |
215 aPlayer name: event target value ])
216 element value: aPlayer name.
217 self renderControllerSelectorFor: aPlayer on: container.
218 !
220 renderStartScreenOn: aSilk
221 | startScreen |
222 startScreen := aSilk DIV: {#id -> 'start-screen'}.
224 players do: [ :each | self renderPlayer: each on: startScreen ].
226 (startScreen BUTTON: 'Random colors')
227 on: #click bind: [ self randomizePlayerColors ].
228 (startScreen BUTTON: 'Random teams')
229 on: #click bind: [ self randomizeTeams ].
231 startScreen BR.
233 (startScreen BUTTON: 'Start')
234 on: #click bind: [ :event | self startGame; status: self scoreDOM ].
235 !
237 scoreDOM
238 | message |
239 message := Silk SPAN: 'Score: '.
240 score associations
241 do: [ :each |
242 (message SPAN: {#class -> 'player-color'. (each value * 10) rounded / 10})
243 element style color: each key ]
244 separatedBy: [ message << ':' ].
245 message << ('/', pointsToWin).
246 ^ message.
247 !
249 showGameWinner: color
250 self showMessage: (self winnerDOM: color) << ' won the game!!'.
251 timeoutId := window
252 setTimeout: [
253 self
254 startScreenVisible: true;
255 hideMessage;
256 status: self scoreDOM << '. ' << (self winnerDOM: color) << ' won the game!!' ]
257 after: 1000.
258 !
260 showMessage: anObject
261 ((Silk at: '#message') resetContents << anObject)
262 element className: 'visible'.
263 !
265 startGame
266 | enabledPlayers |
267 self startScreenVisible: false.
268 field start: (players select: #isEnabled).
269 pointsToWin := (30 / (field players size + 1)) ceiling.
270 score := field colors collect: [ :each | 0 ].
271 !
273 startScreenVisible: aBoolean
274 startScreenVisible := aBoolean.
275 (Silk at: '#start-screen') element
276 className: (aBoolean ifTrue: [ 'visible' ] ifFalse: [ 'hidden' ]).
277 !
279 status: anObject
280 '#status' asSilk resetContents << anObject
281 !
283 updateScore
284 | color teamSize alive points defeated |
285 color := field winningColorIfNone: [ ^ self ].
286 teamSize := field colors at: color.
287 defeated := field players size - teamSize.
288 alive := field liveColors at: color.
289 points := defeated * alive / teamSize * (teamSize + 1) / 2.
290 points := points / (field players size - 1).
291 score at: color put: (score at: color) + points.
292 !
294 updateSize
295 | w h fw fh ratio |
296 w := window innerWidth.
297 h := window innerHeight - ('#title' asSilk element offsetHeight).
298 ratio := field fieldSize x / field fieldSize y.
299 (w / ratio <= h)
300 ifTrue: [ fw := w. fh := w / ratio ]
301 ifFalse: [ fh := h. fw := h * ratio ].
302 '#serpentron' asSilk element style
303 width: fw rounded asString, 'px';
304 marginLeft: ((w - fw) / 2) rounded asString, 'px';
305 marginTop: ((h - fh) / 2) rounded asString, 'px'.
306 '#field' asSilk element style
307 width: fw rounded asString, 'px';
308 height: fh rounded asString, 'px'.
309 !
311 validatePlayerColor: aPlayer
312 | enabledPlayers otherPlayers freeColor |
313 enabledPlayers := players select: #isEnabled.
314 ((enabledPlayers collect: #color) asSet size > 1)
315 ifTrue: [ ^ self ].
316 freeColor := playerColors detect: [ :each | each ~= enabledPlayers anyOne color ].
317 otherPlayers := players select: [ :each | each ~~ aPlayer ].
318 (otherPlayers
319 detect: [ :each | each isEnabled not ]
320 ifNone: [ otherPlayers first ])
321 enabled: true;
322 color: freeColor.
323 !
325 winnerDOM: color
326 | names team message |
327 team := field players select: [ :each | each color = color ].
328 names := ''.
329 (team collect: #name)
330 do: [ :each | names := names, each]
331 separatedBy: [ names := names, ' and ' ].
332 message := Silk SPAN.
333 (message SPAN: {#class -> 'player-color'. names})
334 element style color: color.
335 ^ message
336 ! !
338 !Serpentron methodsFor: 'rendering'!
340 augmentPage
341 Serpentron isCompatibleBrowser ifFalse: [
342 '#serpentron' asSilk resetContents
343 << 'Your browser is not supported.'
344 << Silk BR
345 << 'Please use a modern browser to run the game.'.
346 ^ self ].
347 '#serpentron' asSilk resetContents << 'Loading...'.
348 skin
349 load: 'resources/skin.png'
350 andDo: [ '#serpentron' asSilk resetContents << self ]
351 !
353 renderOnSilk: aSilk
354 | scale title container width height |
355 (title := aSilk DIV: {#id -> 'title'})
356 H1: (Silk A: { #href -> 'http://www.games1729.com/serpentron/'.
357 #target -> '_top'.
358 'Serpentron'});
359 SPAN: {#id -> 'status'. 'version 1.0.1'}.
361 (title IMG: {#id -> 'fullscreen-button'.
362 #title -> 'Toggle fullscreen'.
363 #alt -> 'Toggle fullscreen'.
364 #src -> 'resources/fullscreen.png'})
365 on: #click bind: [ Serpentron toggleFullscreen ].
367 container := aSilk DIV: {#id -> 'field'}.
369 self updateSize.
370 window onresize: [ self updateSize ].
372 container << field.
373 self renderStartScreenOn: container.
375 (container DIV: {#id -> 'message'. #class -> 'hidden'})
376 element style
377 margin: '0 auto'.
378 ! !
380 Serpentron class instanceVariableNames: 'Instance'!
382 !Serpentron class methodsFor: 'compatibility'!
384 isCompatibleBrowser
385 "No reason to polyfill requestAnimationFrame
386 or use vendor prefixes as browsers that do not have it
387 will likely have other incompatibilities."
388 < return window.requestAnimationFrame && true || false >
389 !
391 toggleFullscreen
392 "Sample code from https://developer.mozilla.org/en-US/docs/Web/API/Fullscreen_API"
393 <
394 if (!!document.fullscreenElement &&
395 !!document.mozFullScreenElement && !!document.webkitFullscreenElement && !!document.msFullscreenElement ) {
396 if (document.documentElement.requestFullscreen) {
397 document.documentElement.requestFullscreen();
398 } else if (document.documentElement.msRequestFullscreen) {
399 document.documentElement.msRequestFullscreen();
400 } else if (document.documentElement.mozRequestFullScreen) {
401 document.documentElement.mozRequestFullScreen();
402 } else if (document.documentElement.webkitRequestFullscreen) {
403 document.documentElement.webkitRequestFullscreen(Element.ALLOW_KEYBOARD_INPUT);
404 }
405 } else {
406 if (document.exitFullscreen) {
407 document.exitFullscreen();
408 } else if (document.msExitFullscreen) {
409 document.msExitFullscreen();
410 } else if (document.mozCancelFullScreen) {
411 document.mozCancelFullScreen();
412 } else if (document.webkitExitFullscreen) {
413 document.webkitExitFullscreen();
414 }
415 }
416 >
417 ! !
419 !Serpentron class methodsFor: 'starting'!
421 start
422 (Instance := self new) augmentPage
423 ! !
425 Object subclass: #TronCollider
426 instanceVariableNames: 'canvas context skin animationRequest lastFrameTime particles particlePool particlesPerCollision'
427 package: 'Serpentron'!
428 !TronCollider commentStamp!
429 Particle system for collision effect.!
431 !TronCollider methodsFor: 'accessing'!
433 canvas: aCanvas
434 canvas := aCanvas.
435 context := canvas getContext: '2d'.
436 !
438 skin: aTronSkin
439 skin := aTronSkin
440 ! !
442 !TronCollider methodsFor: 'initialization'!
444 initialize
445 super initialize.
446 particlesPerCollision := 200.
447 particlePool := Queue new.
448 particlesPerCollision * 2 + 10 timesRepeat: [
449 particlePool nextPut: TronColliderParticle new ].
450 particles := OrderedCollection new
451 ! !
453 !TronCollider methodsFor: 'private'!
455 renderFrame: timestamp
456 | liveParticles delta |
457 delta := lastFrameTime
458 ifNil: [ 0 ]
459 ifNotNil: [ timestamp - lastFrameTime ].
460 lastFrameTime := timestamp.
461 "Transcript show: 'renderFrame: ';
462 show: timestamp;
463 show: '; ';
464 show: delta;
465 cr."
466 liveParticles := OrderedCollection new.
467 context clearRect: 0 y: 0 w: canvas width h: canvas height.
468 particles do: [ :each |
469 each
470 update: delta;
471 drawOn: context tileSize: skin tileSize.
472 each
473 ifAlive: [ liveParticles add: each ]
474 ifNotAlive: [ particlePool nextPut: each ] ].
475 particles := liveParticles.
476 animationRequest := particles
477 ifEmpty: [ nil ]
478 ifNotEmpty: [
479 window
480 requestAnimationFrame: [ :ts |
481 self renderFrame: ts ]
482 on: canvas ]
483 !
485 startAnimation
486 animationRequest ifNotNil: [ ^ self ].
487 lastFrameTime := nil.
488 animationRequest := window
489 requestAnimationFrame: [ :ts | self renderFrame: ts ]
490 on: canvas.
491 ! !
493 !TronCollider methodsFor: 'starting'!
495 animateCollisionFor: aPlayer
496 | particle |
497 particlesPerCollision timesRepeat: [
498 particles add:
499 ((particlePool nextIfAbsent: [ TronColliderParticle new ])
500 resetPosition:
501 aPlayer location - 0.5 - (aPlayer direction / 2)
502 color: (Math random < 0.5
503 ifTrue: [ aPlayer color ]
504 ifFalse: [ '#ff3000' ])) ].
505 self startAnimation.
506 ! !
508 Object subclass: #TronColliderParticle
509 instanceVariableNames: 'color size velocity position alpha decay'
510 package: 'Serpentron'!
512 !TronColliderParticle methodsFor: 'accessing'!
514 ifAlive: aliveBlock ifNotAlive: notAliveBlock
515 ^ alpha > 0.01 ifTrue: aliveBlock ifFalse:notAliveBlock
516 !
518 resetPosition: positionPoint color: aString
519 position := positionPoint.
520 color := aString.
521 "Particles return to the pool as soon as they die.
522 Randomize on each reset or the pool will end up sotrted by particles' life time."
523 alpha := 1 - (Math random * 0.5).
524 decay := 0.997 - (Math random * 0.01)
525 ! !
527 !TronColliderParticle methodsFor: 'drawing'!
529 drawOn: aContext tileSize: tileSize
530 aContext
531 globalAlpha: alpha;
532 fillStyle: color;
533 fillRect: (position x - (size / 2)) * tileSize
534 y: (position y - (size / 2)) * tileSize
535 w: size * tileSize
536 h: size * tileSize.
537 ! !
539 !TronColliderParticle methodsFor: 'initialization'!
541 initialize
542 super initialize.
543 size := (Math random * 0.3 + 0.7).
544 velocity := (Math random - 0.5) @ (Math random - 0.5).
545 velocity := velocity / (velocity dist: 0 @ 0) * (Math random raisedTo: 4 + 0.1) * 0.06
546 ! !
548 !TronColliderParticle methodsFor: 'updating'!
550 update: delta
551 position := position + (velocity * delta).
552 alpha := alpha * (decay raisedTo: delta).
553 ! !
555 Object subclass: #TronController
556 instanceVariableNames: 'field player'
557 package: 'Serpentron'!
558 !TronController commentStamp!
559 Abstract superclass for controlling input devices and algorithms.!
561 !TronController methodsFor: 'accessing'!
563 field: aTronField
564 field := aTronField
565 !
567 name
568 self subclassResponsibility.
569 !
571 nextDirection: aPoint
572 "Do not turn back."
573 player nextDirection = (aPoint * (-1 @ -1))
574 ifTrue: [ ^ self ].
575 player nextDirection: aPoint.
576 !
578 player: aTronPlayer
579 player := aTronPlayer
580 ! !
582 !TronController methodsFor: 'computing'!
584 compute
585 !
587 isAtDecisionPoint
588 | loc dir turn |
589 player isFirstMove ifTrue: [ ^ true ].
590 dir := player nextDirection.
591 loc := player location.
592 (field isFreeAt: loc + dir)
593 ifFalse: [ ^ true ].
594 turn := dir rotate90ccw.
595 ((field isFreeAt: loc + turn)
596 and: [ (field isFreeAt: loc + dir + turn) not ])
597 ifTrue: [ ^ true ].
598 turn := dir rotate90cw.
599 ((field isFreeAt: loc + turn)
600 and: [ (field isFreeAt: loc + dir + turn) not ])
601 ifTrue: [ ^ true ].
602 ^ false
603 ! !
605 !TronController methodsFor: 'event handling'!
607 keyDown: keyCode
608 ^ false
609 ! !
611 !TronController methodsFor: 'initialization'!
613 reset
614 ! !
616 TronController class instanceVariableNames: 'directions'!
618 TronController subclass: #TronComputerController1
619 instanceVariableNames: 'weight aggressiveness'
620 package: 'Serpentron'!
622 !TronComputerController1 methodsFor: 'accessing'!
624 name
625 ^ 'Computer'
626 ! !
628 !TronComputerController1 methodsFor: 'computing'!
630 compute
631 | best bestDirection |
632 "player isFirstMove
633 ifTrue: [ self nextDirection: TronPlayer directions atRandom ]."
634 (self isAtDecisionPoint
635 or: [ (field isFreeAt: player location + (player nextDirection * 2)) not ])
636 ifFalse: [ ^ self ].
637 aggressiveness := 200 atRandom.
638 best := 0.
639 TronPlayer directions do: [ :each |
640 weight := 0.
641 self scan: each.
642 weight > best
643 ifTrue: [
644 best := weight.
645 bestDirection := each ]].
646 bestDirection ifNil: [ ^ self ].
647 self nextDirection: bestDirection.
648 ! !
650 !TronComputerController1 methodsFor: 'private'!
652 extend: directionPoint from: nwPoint to: sePoint
653 | point scanDir |
654 scanDir := directionPoint y abs @ directionPoint x abs.
655 point := Point
656 x: (directionPoint x <= 0 ifTrue: [ nwPoint x ] ifFalse: [ sePoint x ])
657 y: (directionPoint y <= 0 ifTrue: [ nwPoint y ] ifFalse: [ sePoint y ]).
658 [ point <= sePoint ]
659 whileTrue: [
660 weight := weight + 1.
661 (field isFreeAt: point)
662 ifFalse: [
663 (self isEnemyHeadAt: point)
664 ifTrue: [ weight := weight + aggressiveness ]
665 ifFalse: [ ^ false ] ].
666 point := point + scanDir ].
667 ^ true
668 !
670 isEnemyHeadAt: aPoint
671 (field playerWithHeadAt: aPoint)
672 ifNotNil: [ :p | ^ p color ~= player color ].
673 ^ false
674 !
676 scan: directionPoint
677 | nw se nextNW nextSE directions scanDir |
678 nw := se := player location + directionPoint.
679 (field isFreeAt: nw) ifFalse: [ ^ self ].
680 directions := TronPlayer directions copy
681 remove: directionPoint * -1;
682 yourself.
683 [ scanDir := directions atRandom.
684 scanDir <= 0 asPoint
685 ifTrue: [ nextNW := nw + scanDir. nextSE := se ]
686 ifFalse: [ nextNW := nw. nextSE := se + scanDir ].
687 (self extend: scanDir from: nextNW to: nextSE)
688 ifTrue: [ nw := nextNW. se := nextSE ]
689 ifFalse: [ directions remove: scanDir ].
690 directions isEmpty not
691 ] whileTrue.
692 ! !
694 TronController subclass: #TronKeyboardController
695 instanceVariableNames: 'keyMap name'
696 package: 'Serpentron'!
698 !TronKeyboardController methodsFor: 'accessing'!
700 keyMap: aDictionary name: aString
701 keyMap := aDictionary.
702 name := 'Keyboard: ', aString.
703 !
705 name
706 ^ name
707 ! !
709 !TronKeyboardController methodsFor: 'event handling'!
711 keyDown: keyCode
712 self nextDirection: (keyMap at: keyCode ifAbsent: [ ^ false ]).
713 ^ true
714 ! !
716 TronKeyboardController class instanceVariableNames: 'keyMaps'!
718 TronController subclass: #TronRandomController
719 instanceVariableNames: ''
720 package: 'Serpentron'!
722 !TronRandomController methodsFor: 'accessing'!
724 name
725 ^ 'Computer (random)'
726 ! !
728 !TronRandomController methodsFor: 'computing'!
730 compute
731 | dirs |
732 (self isAtDecisionPoint or: [ 50 atRandom = 1 ])
733 ifFalse: [ ^ self ].
734 dirs := TronPlayer directions
735 select: [ :each | field isFreeAt: player location + each ].
736 dirs ifNotEmpty: [ self nextDirection: dirs atRandom ]
737 ! !
739 Object subclass: #TronField
740 instanceVariableNames: 'skin size matrix players livePlayers colors liveColors canvas context collider timerId onEndGame'
741 package: 'Serpentron'!
742 !TronField commentStamp!
743 The game field. Provides game logic and rendering.!
745 !TronField methodsFor: 'accessing'!
747 at: aPoint
748 ^ (matrix at: aPoint y) at: aPoint x
749 !
751 at: aPoint ifAbsent: aBlock
752 ^ matrix
753 at: aPoint y
754 ifPresent: [ :value | value at: aPoint x ifAbsent: aBlock ]
755 ifAbsent: aBlock
756 !
758 at: aPoint put: aSegment
759 (matrix at: aPoint y) at: aPoint x put: aSegment
760 !
762 colors
763 ^ colors
764 !
766 fieldSize
767 ^ size
768 !
770 isFreeAt: aPoint
771 ^ (self at: aPoint ifAbsent: [ ^ false ]) isNil
772 !
774 isGameFinished
775 ^ liveColors size < 2
776 !
778 liveColors
779 ^ liveColors
780 !
782 playerWithHeadAt: aPoint
783 | s |
784 s := self at: aPoint ifAbsent: [ ^ nil ].
785 s isHead ifTrue: [ ^ s player ] ifFalse: [ ^ nil ]
786 !
788 players
789 ^ players
790 !
792 skin
793 ^ skin
794 !
796 skin: aTronSkin
797 skin := aTronSkin
798 !
800 winningColorIfNone: aBlock
801 ^ (liveColors size = 1)
802 ifTrue: [ liveColors keys anyOne ]
803 ifFalse: aBlock.
804 ! !
806 !TronField methodsFor: 'event handling'!
808 keyDown: event
809 "Check all players rather than livePlayers
810 so that preventDefault is called for all used keys."
811 (players anySatisfy: [ :each | each keyDown: event keyCode ])
812 ifTrue: [ event preventDefault ].
813 timerId ifNil: [ self startIfAllReady ].
814 ! !
816 !TronField methodsFor: 'initialization'!
818 initialize
819 super initialize.
820 livePlayers := players := #().
821 size := 50 @ 35
822 ! !
824 !TronField methodsFor: 'observing'!
826 onEndGame: aBlock
827 onEndGame := aBlock
828 ! !
830 !TronField methodsFor: 'private'!
832 endGame
833 self stopTimer.
834 livePlayers := #().
835 onEndGame ifNotNil: #value.
836 !
838 killPlayer: aPlayer
839 collider animateCollisionFor: aPlayer.
840 livePlayers remove: aPlayer.
841 self updateLiveColors.
842 !
844 locatePlayers
845 players size = 2 ifTrue: [
846 (players at: 1) location: 16 @ 18.
847 (players at: 2) location: 35 @ 18.
848 ^ self ].
849 players size = 3 ifTrue: [
850 (players at: 1) location: 18 @ 13.
851 (players at: 2) location: 18 @ 23.
852 (players at: 3) location: 33 @ 18.
853 ^ self ].
854 players size = 4 ifTrue: [
855 (players at: 1) location: 16 @ 11.
856 (players at: 2) location: 35 @ 11.
857 (players at: 3) location: 16 @ 25.
858 (players at: 4) location: 35 @ 25.
859 ^ self ].
860 self error: 'Invalid number of players.'
861 !
863 renderCanvasOn: aSilk
864 ^ aSilk CANVAS: {
865 #width -> (size x * skin tileSize).
866 #height -> (size y * skin tileSize)}.
867 !
869 startIfAllReady
870 (livePlayers isEmpty not
871 and: [ livePlayers allSatisfy: #isReady ])
872 ifTrue: [ self startTimer ]
873 !
875 startTimer
876 timerId ifNotNil: [ self error: 'Timer already running.' ].
877 timerId := window setInterval: [ self update ] every: 75.
878 !
880 update
881 | lpCopy |
882 lpCopy := livePlayers copy.
883 lpCopy do: [ :each |
884 | l |
885 l := each location.
886 self at: l put: each move.
887 skin drawField: self on: context at: l ].
888 lpCopy do: [ :each |
889 | l other |
890 l := each location.
891 (self isFreeAt: l)
892 ifTrue: [ self at: l put: each headSegment. ]
893 ifFalse: [
894 self killPlayer: each.
895 "Check for head-to-head collision."
896 other := self playerWithHeadAt: l.
897 (other isNil | (other = each))
898 ifFalse: [
899 self killPlayer: other.
900 self at: l put: nil. ]]].
901 livePlayers do: [ :each |
902 skin drawField: self on: context at: each location ].
903 self isGameFinished ifTrue: [ ^ self endGame ].
904 livePlayers do: #compute.
905 !
907 updateLiveColors
908 liveColors := Dictionary new.
909 livePlayers do: [ :each |
910 liveColors
911 at: each color
912 ifPresent: [ :v | liveColors at: each color put: v + 1 ]
913 ifAbsent: [ liveColors at: each color put: 1 ]].
914 ! !
916 !TronField methodsFor: 'rendering'!
918 renderOnSilk: aSilk
919 | backgroundCanvas |
921 backgroundCanvas := (self renderCanvasOn: aSilk) element.
923 canvas := (self renderCanvasOn: aSilk) element.
924 context := canvas getContext: '2d'.
926 collider := TronCollider new
927 canvas: (self renderCanvasOn: aSilk) element;
928 skin: skin.
930 skin drawBackgroundOn: (backgroundCanvas getContext: '2d') from: 1 @ 1 to: size
931 ! !
933 !TronField methodsFor: 'starting'!
935 start: anArrayOfPlayers
936 players := anArrayOfPlayers.
937 livePlayers := players copy.
938 self updateLiveColors.
939 colors := liveColors.
940 matrix := (1 to: size y) collect: [ :i | Array new: size x ].
941 context clearRect: 0 y: 0 w: canvas width h: canvas height.
942 self locatePlayers.
943 players do: [ :each | each field: self; reset; compute ].
944 players do: [ :each |
945 self at: each location put: each headSegment.
946 skin drawField: self on: context at: each location ].
947 self startIfAllReady.
948 ! !
950 !TronField methodsFor: 'stopping'!
952 stopTimer
953 timerId ifNotNil: [
954 window clearInterval: timerId.
955 timerId := nil ]
956 ! !
958 Object subclass: #TronPlayer
959 instanceVariableNames: 'enabled color name controller segments location moved direction nextDirection onColorChange onEnabledChange onControllerChange'
960 package: 'Serpentron'!
962 !TronPlayer methodsFor: 'accessing'!
964 color
965 ^ color
966 !
968 color: anObject
969 color := anObject.
970 onColorChange ifNotNil: #value.
971 !
973 controller
974 ^ controller
975 !
977 controller: aTronController
978 aTronController player: self.
979 controller := aTronController.
980 onControllerChange ifNotNil: #value.
981 !
983 direction
984 ^ direction
985 !
987 enabled: aBoolean
988 enabled := aBoolean.
989 onEnabledChange ifNotNil: #value.
990 !
992 field: aField
993 controller field: aField
994 !
996 headSegment
997 ^ segments at: direction
998 !
1000 isEnabled
1001 ^ enabled
1004 isFirstMove
1005 ^ moved not
1008 isReady
1009 ^ nextDirection notNil
1012 location
1013 ^ location
1016 location: anObject
1017 location := anObject
1020 name
1021 ^ name
1024 name: anObject
1025 name := anObject.
1028 nextDirection
1029 ^ nextDirection
1032 nextDirection: aPoint
1033 moved ifFalse: [ direction := aPoint ].
1034 nextDirection := aPoint
1035 ! !
1037 !TronPlayer methodsFor: 'event handling'!
1039 keyDown: keyCode
1040 ^ controller keyDown: keyCode
1041 ! !
1043 !TronPlayer methodsFor: 'initialization'!
1045 initialize
1046 super initialize.
1047 enabled := true.
1048 self reset; initializeSegments.
1051 reset
1052 direction := 0 @ -1.
1053 nextDirection := nil.
1054 moved := false.
1055 controller ifNotNil: [ controller reset ].
1056 ! !
1058 !TronPlayer methodsFor: 'observing'!
1060 onColorChange: aBlock
1061 onColorChange := aBlock.
1064 onControllerChange: aBlock
1065 onControllerChange := aBlock.
1068 onEnabledChange: aBlock
1069 onEnabledChange := aBlock.
1070 ! !
1072 !TronPlayer methodsFor: 'private'!
1074 initializeSegments
1075 segments := Dictionary new.
1076 TronPlayer directionNames keysAndValuesDo: [ :to :toName |
1077 segments
1078 at: to
1079 put: (TronHead new
1080 player: self;
1081 sprite: 'head', toName;
1082 direction: to);
1083 at: {to. to}
1084 put: (TronSegment new
1085 player: self;
1086 sprite: 'body', toName).
1087 TronPlayer directionNames keysAndValuesDo: [ :from :fromName |
1088 (from x = to x) | (from y = to y) ifFalse: [
1089 segments
1090 at: {from. to}
1091 put: (TronSegment new
1092 player: self;
1093 sprite: 'body', fromName, 'To', toName) ]]].
1094 ! !
1096 !TronPlayer methodsFor: 'updating'!
1098 compute
1099 controller compute
1102 move
1103 | segment |
1104 segment := segments at: {direction. nextDirection} ifAbsent: [ nil ].
1105 direction := nextDirection.
1106 location := location + direction.
1107 moved := true.
1108 ^ segment
1109 ! !
1111 TronPlayer class instanceVariableNames: 'directions directionNames'!
1113 !TronPlayer class methodsFor: 'initialization'!
1115 directionNames
1116 ^ directionNames
1119 directions
1120 ^ directions
1123 initialize
1124 super initialize.
1125 directionNames := Dictionary new
1126 at: 0 @ -1 put: 'North';
1127 at: 1 @ 0 put: 'East';
1128 at: 0 @ 1 put: 'South';
1129 at: -1 @ 0 put: 'West';
1130 yourself.
1131 directions := directionNames keys.
1132 ! !
1134 Object subclass: #TronSegment
1135 instanceVariableNames: 'player sprite'
1136 package: 'Serpentron'!
1138 !TronSegment methodsFor: 'accessing'!
1140 color
1141 ^ player color
1144 isHead
1145 ^ false
1148 player
1149 ^ player
1152 player: anObject
1153 player := anObject
1156 sprite
1157 ^ sprite
1160 sprite: anObject
1161 sprite := anObject
1162 ! !
1164 TronSegment subclass: #TronHead
1165 instanceVariableNames: 'direction'
1166 package: 'Serpentron'!
1168 !TronHead methodsFor: 'accessing'!
1170 direction
1171 ^ direction
1174 direction: anObject
1175 direction := anObject
1178 isHead
1179 ^ true
1180 ! !
1182 Object subclass: #TronSkin
1183 instanceVariableNames: 'skinMap skinImage tileSize maskOffset'
1184 package: 'Serpentron'!
1186 !TronSkin methodsFor: 'accessing'!
1188 tileSize
1189 ^ tileSize
1190 ! !
1192 !TronSkin methodsFor: 'drawing'!
1194 drawBackgroundOn: aContext at: aPoint
1195 self drawTile: #background offset: aPoint - 1 on: aContext at: aPoint;
1196 drawTile: #backgroundTile on: aContext at: aPoint
1199 drawBackgroundOn: aContext from: nwPoint to: sePoint
1200 nwPoint y to: sePoint y do: [ :row |
1201 nwPoint x to: sePoint x do: [ :col |
1202 self drawBackgroundOn: aContext at: col @ row ]]
1205 drawField: aField on: aContext at: aPoint
1206 | x y segment |
1208 x := (aPoint - 1) x * tileSize.
1209 y := (aPoint - 1) y * tileSize.
1211 aContext
1212 clearRect: x and: y and: tileSize and: tileSize.
1214 segment := (aField at: aPoint) ifNil: [ ^ self ].
1216 self
1217 drawTile: segment sprite
1218 offset: maskOffset
1219 on: aContext
1220 at: aPoint.
1221 aContext
1222 globalCompositeOperation: 'source-atop';
1223 fillStyle: segment color;
1224 fillRect: x and: y and: tileSize and: tileSize.
1225 self drawTile: segment sprite on: aContext at: aPoint.
1227 aContext globalCompositeOperation: 'source-over'.
1230 drawSkinImageOn: aContext source: sourcePoint destination: destinationPoint
1231 aContext drawImage: skinImage
1232 sx: sourcePoint x
1233 sy: sourcePoint y
1234 sw: tileSize
1235 sh: tileSize
1236 dx: destinationPoint x
1237 dy: destinationPoint y
1238 dw: tileSize
1239 dh: tileSize
1242 drawTile: aSymbol offset: offsetPoint on: aContext at: targetPoint
1243 self
1244 drawSkinImageOn: aContext
1245 source: ((skinMap at: aSymbol) + offsetPoint) * tileSize
1246 destination: (targetPoint - 1) * tileSize
1249 drawTile: aSymbol on: aContext at: aPoint
1250 self drawTile: aSymbol offset: 0@0 on: aContext at: aPoint
1251 ! !
1253 !TronSkin methodsFor: 'initialization'!
1255 initialize
1256 super initialize.
1257 skinMap := Dictionary new
1258 at: #background put: 0@0;
1259 at: #backgroundBottomRight put: 49@34;
1260 at: #backgroundTile put: 0@35;
1261 at: #headNorth put: 1@35;
1262 at: #headEast put: 2@35;
1263 at: #headSouth put: 3@35;
1264 at: #headWest put: 4@35;
1265 at: #bodyNorth put: 5@35;
1266 at: #bodyEast put: 6@35;
1267 at: #bodySouth put: 7@35;
1268 at: #bodyWest put: 8@35;
1269 at: #bodySouthToEast put: 9@35;
1270 at: #bodyWestToNorth put: 9@35;
1271 at: #bodyNorthToEast put: 10@35;
1272 at: #bodyWestToSouth put: 10@35;
1273 at: #bodyNorthToWest put: 11@35;
1274 at: #bodyEastToSouth put: 11@35;
1275 at: #bodySouthToWest put: 12@35;
1276 at: #bodyEastToNorth put: 12@35;
1277 yourself.
1278 maskOffset := 12 @ 0.
1279 skinImage := document createElement: 'img'
1280 ! !
1282 !TronSkin methodsFor: 'loading'!
1284 load: url andDo: aBlock
1285 skinImage onload: [
1286 tileSize := skinImage width / 50.
1287 aBlock value ].
1288 skinImage src: url.
1289 ! !
1291 !Point methodsFor: '*Serpentron'!
1293 rotate90ccw
1294 ^ self y @ self x negated
1297 rotate90cw
1298 ^ self y negated @ self x
1299 ! !