Smalltalk createPackage: 'Serpentron'!
(Smalltalk packageAt: 'Serpentron') imports: {'silk/Silk'}!
Object subclass: #Serpentron
	instanceVariableNames: 'field skin players playerColors controllerPrototypes score pointsToWin'
	package: 'Serpentron'!
!Serpentron commentStamp!
The game UI.!

!Serpentron methodsFor: 'initialization'!

initialize
	super initialize.
	playerColors := #('#377eb8' '#e41a1c' '#4daf4a' '#ff7f00' '#984ea3' '#b3ad78').
	skin := TronSkin new.
	field := TronField new
		skin: skin;
		onEndGame: [ self handleEndGame ].
	self initializePlayers; initializeControllers.
	(Silk fromElement: document)
		on: #keydown bind: [ :event | field keyDown: event ].
! !

!Serpentron methodsFor: 'private'!

handleEndGame
	| color |
	field isGameFinished
		"Interrupted game, no winner."
		ifFalse: [ ^ self startScreenVisible: true ].
	color := field winningColorIfNone: [ 
		^ self status: 'No winner in this round.'; nextRound ].
	self updateScore.
	(score anySatisfy: [ :each | each >= pointsToWin ])
		ifFalse: [
			self status: (self winnerDOM: color) << ' won the round.'.
			^ self nextRound ].
	self status: self scoreDOM.
	window
		setTimeout: [ 
			self startScreenVisible: true.
			self hideMessage.
			self status: self scoreDOM << '. ' << (self winnerDOM: color) << ' won!!' ]
		after: 2000.	
	window
		setTimeout: [ self showMessage: (self winnerDOM: color) << ' won!!' ]
		after: 1000.
!

hideMessage
	(Silk at: '#message') element className: 'hidden'.
!

initializeControllers
	controllerPrototypes := {
		TronKeyboardController new
			keyMap: #{
				38 -> (0 @ -1).
				39 -> (1 @ 0).
				40 -> (0 @ 1).
				37 -> (-1 @ 0)}
			name: 'arrows'.
		TronKeyboardController new
			keyMap: #{
				87 -> (0 @ -1).
				68 -> (1 @ 0).
				83 -> (0 @ 1).
				65 -> (-1 @ 0)}
			name: 'WASD'.
		TronKeyboardController new
			keyMap: #{
				89 -> (0 @ -1).
				74 -> (1 @ 0).
				72 -> (0 @ 1).
				71 -> (-1 @ 0)}
			name: 'YGHJ'.
		TronKeyboardController new
			keyMap: #{
				80 -> (0 @ -1).
				222 -> (1 @ 0).
				59 -> (0 @ 1).
				76 -> (-1 @ 0)}
			name: 'PL;'''.
		TronComputerController1 new.
		"TronRandomController new"
	}.
	(players at: 1) controller: (controllerPrototypes at: 1) copy.
	(players at: 2) controller: (controllerPrototypes at: 5) copy.
	(players at: 3) controller: (controllerPrototypes at: 5) copy.
	(players at: 4) controller: (controllerPrototypes at: 5) copy.
!

initializePlayers
	players := { 
		TronPlayer new
			name: 'Player 1';
			color: (playerColors at: 1).
		TronPlayer new
			name: 'Player 2';
			color: (playerColors at: 2).
		TronPlayer new
			name: 'Player 3';
			color: (playerColors at: 3);
			enabled: false.
		TronPlayer new
			name: 'Player 4';
			color: (playerColors at: 4);
			enabled: false
	}.
!

nextRound
	window
		setTimeout: [
			self status: self scoreDOM.
			field start: field players ]
		after: 2000.
!

randomizePlayerColors
	| enabledPlayers |
	enabledPlayers := players select: #isEnabled.
	enabledPlayers do: [ :each |
		| color |
		[ color := playerColors atRandom.
		  enabledPlayers allSatisfy: [ :p |
		  	  p = each | (p color ~= color) ]
		] whileFalse.
		each color: color.
	].
!

randomizeTeams
	| colorA colorB teamA |
	players do: [ :each | each enabled: true ].
	colorA := playerColors atRandom.
	[ colorB := playerColors atRandom.
	  colorB = colorA ] whileTrue.
	teamA := players copy.
	players size // 2 
		timesRepeat: [ (teamA remove: teamA atRandom) color: colorB ].
	teamA do: [ :each | each color: colorA ].
!

renderColorSelectorFor: aPlayer on: aSilk
	| container buttons onChange |
	container := aSilk SPAN: {#class -> 'color-selector'}.
	buttons := Dictionary from:
		(playerColors collect: [ :each |
			| button |
			button := container A.
			button on: #click bind: [ 
				aPlayer enabled: true; color: each.
				self validatePlayerColor: aPlayer ].
			button element style background: each.
			each -> button ]).
	buttons at: #disabled put: (container A
		SPAN: '✗';
		on: #click bind: [ 
			aPlayer enabled: false.
			self validatePlayerColor: aPlayer ]).
	onChange := [
		buttons keysAndValuesDo: [ :k :v |
			(aPlayer isEnabled not & k = #disabled) |
				(aPlayer isEnabled & k = aPlayer color)
					ifTrue: [ v element className: 'selected-color-button' ]
					ifFalse: [ v element className: 'color-button' ] ] ].
	aPlayer
		onEnabledChange: onChange;
		onColorChange: onChange.
	onChange value.
!

renderControllerSelectorFor: aPlayer on: aSilk
	| select options onChange |
	select := aSilk SELECT.
	options := Dictionary new.
	controllerPrototypes do: [ :each |
		options at: each name put: (select OPTION: each name) element ].
	select
		on: #change
		bind: [
			aPlayer controller:
				(controllerPrototypes
					detect: [ :each | each name = select element value ])
						copy ].
	onChange := [
		| value |
		value := aPlayer controller name.
		(options at: value) selected: 'selected'.
		aPlayer controller class = TronKeyboardController
			ifTrue: [
				players do: [ :each |
					(each ~= aPlayer and: [ each controller name = value ])
						ifTrue: [ each controller: TronComputerController1 new ]]]].
	aPlayer onControllerChange: onChange.
	onChange value.
!

renderPlayer: aPlayer on: aSilk
	| container |
	container := aSilk DIV: { #class -> 'player' }.
	self renderColorSelectorFor: aPlayer on: container.
	(container INPUT
		on: #change bind: [ :event |
			aPlayer name: event target value ])
		element value: aPlayer name.
	self renderControllerSelectorFor: aPlayer on: container.
!

renderStartScreenOn: aSilk
	| startScreen |
	startScreen := aSilk DIV: {#id -> 'start-screen'}.
	
	players do: [ :each | self renderPlayer: each on: startScreen ].
	
	(startScreen BUTTON: 'Random colors')
		on: #click bind: [ self randomizePlayerColors ].
	(startScreen BUTTON: 'Random teams')
		on: #click bind: [ self randomizeTeams ].

	startScreen BR.

	(startScreen BUTTON: 'Start')
		on: #click bind: [ :event | self startGame; status: self scoreDOM ].
!

scoreDOM
	| message |
	message := Silk SPAN: 'Score: '.
	score associations
		do: [ :each | 
			(message SPAN: {#class -> 'player-color'. (each value * 10) rounded / 10})
				element style color: each key ]
		separatedBy: [ message << ':' ].
	message << ('/', pointsToWin).
	^ message.
!

showMessage: anObject
	((Silk at: '#message') resetContents << anObject)
		element className: 'visible'.
!

startGame
	| enabledPlayers |
	self startScreenVisible: false.
	field start: (players select: #isEnabled).
	pointsToWin := (30 / (field players size + 1)) ceiling.
	score := field colors collect: [ :each | 0 ].
!

startScreenVisible: aBoolean
	(Silk at: '#start-screen') element 
		className: (aBoolean ifTrue: [ 'visible' ] ifFalse: [ 'hidden' ])
!

status: anObject
	'#status' asSilk resetContents << anObject
!

updateScore
	| color teamSize alive points defeated |
	color := field winningColorIfNone: [ ^ self ].
	teamSize := field colors at: color.
	defeated := field players size - teamSize.
	alive := field liveColors at: color.
	points := defeated * alive / teamSize * (teamSize + 1) / 2.
	points := points / (field players size - 1).
	score at: color	put: (score at: color) + points.
!

validatePlayerColor: aPlayer
	| enabledPlayers otherPlayers freeColor |
	enabledPlayers := players select: #isEnabled.
	((enabledPlayers collect: #color) asSet size > 1)
		ifTrue: [ ^ self ].
	freeColor := playerColors detect: [ :each | each ~= enabledPlayers anyOne color ].
	otherPlayers := players select: [ :each | each ~~ aPlayer ].
	(otherPlayers
		detect: [ :each | each isEnabled not ]
		ifNone: [ otherPlayers first ])
			enabled: true;
			color: freeColor.
!

winnerDOM: color
	| names team message |	
	team := field players select: [ :each | each color = color ].
	names := ''.
	(team collect: #name)
		do: [ :each | names := names, each]
		separatedBy: [ names := names, ' and ' ].
	message := Silk SPAN.
	(message SPAN: {#class -> 'player-color'. names})
		element style color: color.
	^ message
! !

!Serpentron methodsFor: 'rendering'!

augmentPage
	'#serpentron' asSilk resetContents << 'Loading...'.
	skin
		load: 'resources/skin.png'
		andDo: [ '#serpentron' asSilk resetContents << self ]
!

renderOnSilk: aSilk
	| scale container width height |
	scale := 1.
	skin tileSize >= 20
		ifTrue: [ scale := 0.5 ].
	skin tileSize < 10
		ifTrue: [ scale := 2].
	
	width := field fieldSize x * skin tileSize * scale.
	height := field fieldSize y * skin tileSize * scale.
	
	aSilk element style
		width: width asString , 'px'.
	
	(aSilk DIV: {#id -> 'title'})
		H1: (Silk A: {	#href -> 'http://www.games1729.com/serpentron/'.
						#target -> '_top'.
						'Serpentron'});
		SPAN: {#id -> 'status'. '1.0 beta'}.
	
	container := aSilk DIV: {#id -> 'field'}.
	container element style
		width: width asString , 'px';
		height: height asString , 'px'.
	
	container << field.
	self renderStartScreenOn: container.

	(container DIV: {#id -> 'message'. #class -> 'hidden'})
		element style
			margin: '0 auto'.
	
	aSilk << container.
! !

Serpentron class instanceVariableNames: 'Instance'!

!Serpentron class methodsFor: 'starting'!

start
	(Instance := self new) augmentPage
! !

Object subclass: #TronCollider
	instanceVariableNames: 'canvas context skin animationRequest lastFrameTime particles particlePool particlesPerCollision'
	package: 'Serpentron'!
!TronCollider commentStamp!
Particle system for collision effect.!

!TronCollider methodsFor: 'accessing'!

canvas: aCanvas
	canvas := aCanvas.
	context := canvas getContext: '2d'.
!

skin: aTronSkin
	skin := aTronSkin
! !

!TronCollider methodsFor: 'initialization'!

initialize
	super initialize.
	particlesPerCollision := 200.
	particlePool := Queue new.
	particlesPerCollision * 2 + 10 timesRepeat: [ 
		particlePool nextPut: TronColliderParticle new ].
	particles := OrderedCollection new
! !

!TronCollider methodsFor: 'private'!

renderFrame: timestamp
	| liveParticles delta |
	delta := lastFrameTime
		ifNil: [ 0 ]
		ifNotNil: [	timestamp - lastFrameTime ].
	lastFrameTime := timestamp.
	"Transcript show: 'renderFrame: ';
		show: timestamp;
		show: '; ';
		show: delta;
		cr."
	liveParticles := OrderedCollection new.
	context clearRect: 0 y: 0 w: canvas width h: canvas height.
	particles do: [ :each |
		each
			update: delta;
			drawOn: context tileSize: skin tileSize.
		each
			ifAlive: [ liveParticles add: each ]
			ifNotAlive: [ particlePool nextPut: each ] ].
	particles := liveParticles.
	animationRequest := particles
		ifEmpty: [ nil ]
		ifNotEmpty: [
			window
				requestAnimationFrame: [ :ts | 
					self renderFrame: ts ]
				on: canvas ]
!

startAnimation
	animationRequest ifNotNil: [ ^ self ].
	lastFrameTime := nil.
	animationRequest := window
		requestAnimationFrame: [ :ts | self renderFrame: ts ]
		on: canvas.
! !

!TronCollider methodsFor: 'starting'!

animateCollisionFor: aPlayer
	| particle |
	particlesPerCollision timesRepeat: [
		particles add: 
			((particlePool nextIfAbsent: [ TronColliderParticle new ])
				resetPosition: 
					aPlayer location - 0.5 - (aPlayer direction / 2)
				color: (Math random < 0.5
					ifTrue: [ aPlayer color ]
					ifFalse: [ '#ff3000' ])) ].
	self startAnimation.
! !

Object subclass: #TronColliderParticle
	instanceVariableNames: 'color size velocity position alpha decay'
	package: 'Serpentron'!

!TronColliderParticle methodsFor: 'accessing'!

ifAlive: aliveBlock ifNotAlive: notAliveBlock
	^ alpha > 0.01 ifTrue: aliveBlock ifFalse:notAliveBlock
!

resetPosition: positionPoint color: aString
	position := positionPoint.
	color := aString.
	"Particles return to the pool as soon as they die.
	Randomize on each reset or the pool will end up sotrted by particles' life time."
	alpha := 1 - (Math random * 0.5).
	decay := 0.997 - (Math random * 0.01)
! !

!TronColliderParticle methodsFor: 'drawing'!

drawOn: aContext tileSize: tileSize
	aContext
		globalAlpha: alpha;
		fillStyle: color;
		fillRect: (position x - (size / 2)) * tileSize
			y: (position y - (size / 2)) * tileSize
			w: size * tileSize
			h: size * tileSize.
! !

!TronColliderParticle methodsFor: 'initialization'!

initialize
	super initialize.
	size := (Math random * 0.3 + 0.7).
	velocity := (Math random - 0.5) @ (Math random - 0.5).
	velocity := velocity / (velocity dist: 0 @ 0) * (Math random raisedTo: 4 + 0.1) * 0.06
! !

!TronColliderParticle methodsFor: 'updating'!

update: delta
	position := position + (velocity * delta).
	alpha := alpha * (decay raisedTo: delta).
! !

Object subclass: #TronController
	instanceVariableNames: 'field player'
	package: 'Serpentron'!
!TronController commentStamp!
Abstract superclass for controlling input devices and algorithms.!

!TronController methodsFor: 'accessing'!

field: aTronField
	field := aTronField
!

name
	self subclassResponsibility.
!

nextDirection: aPoint
	"Do not turn back."
	player nextDirection = (aPoint * (-1 @ -1))
		ifTrue: [ ^ self ].
	player nextDirection: aPoint.
!

player: aTronPlayer
	player := aTronPlayer
! !

!TronController methodsFor: 'computing'!

compute
!

isAtDecisionPoint
	| loc dir turn |
	player isFirstMove ifTrue: [ ^ true ].
	dir := player nextDirection.
	loc := player location.
	(field isFreeAt: loc + dir)
		ifFalse: [ ^ true ].
	turn := dir rotate90ccw.
	((field isFreeAt: loc + turn)
		and: [ (field isFreeAt: loc + dir + turn) not ])
		ifTrue: [ ^ true ].
	turn := dir rotate90cw.
	((field isFreeAt: loc + turn)
		and: [ (field isFreeAt: loc + dir + turn) not ])
		ifTrue: [ ^ true ].
	^ false
! !

!TronController methodsFor: 'event handling'!

keyDown: keyCode
	^ false
! !

!TronController methodsFor: 'initialization'!

reset
! !

TronController class instanceVariableNames: 'directions'!

TronController subclass: #TronComputerController1
	instanceVariableNames: 'weight aggressiveness'
	package: 'Serpentron'!

!TronComputerController1 methodsFor: 'accessing'!

name
	^ 'Computer'
! !

!TronComputerController1 methodsFor: 'computing'!

compute
	| best bestDirection |
	"player isFirstMove
		ifTrue: [ self nextDirection: TronPlayer directions atRandom ]."
	(self isAtDecisionPoint 
		or: [ (field isFreeAt: player location + (player nextDirection * 2)) not ])
		ifFalse: [ ^ self ].
	aggressiveness := 200 atRandom.
	best := 0.
	TronPlayer directions do: [ :each | 
		weight := 0.
		self scan: each.
		weight > best
			ifTrue:	[
				best := weight.
				bestDirection := each ]].
	bestDirection ifNil: [ ^ self ].
	self nextDirection: bestDirection.
! !

!TronComputerController1 methodsFor: 'private'!

extend: directionPoint from: nwPoint to: sePoint
	| point scanDir |
	scanDir := directionPoint y abs @ directionPoint x abs.
	point := Point
		x: (directionPoint x <= 0 ifTrue: [ nwPoint x ] ifFalse: [ sePoint x ])
		y: (directionPoint y <= 0 ifTrue: [ nwPoint y ] ifFalse: [ sePoint y ]).
	[ point <= sePoint ] 
		whileTrue: [
			weight := weight + 1.
			(field isFreeAt: point)
				ifFalse: [ 
					(self isEnemyHeadAt: point)
						ifTrue: [ weight := weight + aggressiveness ]
						ifFalse: [ ^ false ] ].
			point := point + scanDir ].
	^ true
!

isEnemyHeadAt: aPoint
	(field playerWithHeadAt: aPoint)
		ifNotNil: [ :p | ^ p color ~= player color ].
	^ false
!

scan: directionPoint
	| nw se nextNW nextSE directions scanDir |
	nw := se := player location + directionPoint.
	(field isFreeAt: nw) ifFalse: [ ^ self ].
	directions := TronPlayer directions copy
		remove: directionPoint * -1;
		yourself.
	[	scanDir := directions atRandom.
		scanDir <= 0 asPoint
			ifTrue: [ nextNW := nw + scanDir. nextSE := se ]
			ifFalse: [ nextNW := nw. nextSE := se + scanDir ].
		(self extend: scanDir from: nextNW to: nextSE)
			ifTrue: [ nw := nextNW. se := nextSE ]
			ifFalse: [ directions remove: scanDir ].
		directions isEmpty not
	] whileTrue.
! !

TronController subclass: #TronKeyboardController
	instanceVariableNames: 'keyMap name'
	package: 'Serpentron'!

!TronKeyboardController methodsFor: 'accessing'!

keyMap: aDictionary name: aString
	keyMap := aDictionary.
	name := 'Keyboard: ', aString.
!

name
	^ name
! !

!TronKeyboardController methodsFor: 'event handling'!

keyDown: keyCode
	self nextDirection: (keyMap at: keyCode ifAbsent: [ ^ false ]).
	^ true
! !

TronKeyboardController class instanceVariableNames: 'keyMaps'!

TronController subclass: #TronRandomController
	instanceVariableNames: ''
	package: 'Serpentron'!

!TronRandomController methodsFor: 'accessing'!

name
	^ 'Computer (random)'
! !

!TronRandomController methodsFor: 'computing'!

compute
	| dirs |
	(self isAtDecisionPoint or: [ 50 atRandom = 1 ])
		ifFalse: [ ^ self ].
	dirs := TronPlayer directions
		select: [ :each | field isFreeAt: player location + each ].
	dirs ifNotEmpty: [ self nextDirection: dirs atRandom ]
! !

Object subclass: #TronField
	instanceVariableNames: 'skin size matrix players livePlayers colors liveColors canvas context collider timerId onEndGame'
	package: 'Serpentron'!
!TronField commentStamp!
The game field. Provides game logic and rendering.!

!TronField methodsFor: 'accessing'!

at: aPoint
	^ (matrix at: aPoint y) at: aPoint x
!

at: aPoint ifAbsent: aBlock
	^ matrix
		at: aPoint y 
		ifPresent: [ :value | value at: aPoint x ifAbsent: aBlock ]
		ifAbsent: aBlock
!

at: aPoint put: aSegment
	(matrix at: aPoint y) at: aPoint x put: aSegment
!

colors
	^ colors
!

fieldSize
	^ size
!

isFreeAt: aPoint
	^ (self at: aPoint ifAbsent: [ ^ false ]) isNil
!

isGameFinished
	^ liveColors size < 2
!

liveColors
	^ liveColors
!

playerWithHeadAt: aPoint
	| s |
	s := self at: aPoint ifAbsent: [ ^ nil ].
	s isHead ifTrue: [ ^ s player ] ifFalse: [ ^ nil ]
!

players
	^ players
!

skin
	^ skin
!

skin: aTronSkin
	skin := aTronSkin
!

winningColorIfNone: aBlock
	^ (liveColors size = 1)
		ifTrue: [ liveColors keys anyOne ]
		ifFalse: aBlock.
! !

!TronField methodsFor: 'event handling'!

keyDown: event
	"Handle Esc key."
	livePlayers isEmpty not & (event keyCode = 27)
		ifTrue: [
			event preventDefault.
			self endGame.
			^ self ].
	"Check all players rather than livePlayers 
	so that preventDefault is called for all used keys."
	(players anySatisfy: [ :each | each keyDown: event keyCode ])
		ifTrue: [ event preventDefault ].
	timerId ifNil: [ self startIfAllReady ].
! !

!TronField methodsFor: 'initialization'!

initialize
	super initialize.
	livePlayers := players := #().
	size := 50 @ 35
! !

!TronField methodsFor: 'observing'!

onEndGame: aBlock
	onEndGame := aBlock
! !

!TronField methodsFor: 'private'!

endGame
	self stopTimer.
	livePlayers := #().
	onEndGame ifNotNil: #value.
!

killPlayer: aPlayer
	collider animateCollisionFor: aPlayer.
	livePlayers remove: aPlayer.
	self updateLiveColors.
!

locatePlayers
	players size = 2 ifTrue: [
		(players at: 1) location: 16 @ 18.
		(players at: 2) location: 35 @ 18.
		^ self ].
	players size = 3 ifTrue: [
		(players at: 1) location: 18 @ 13.
		(players at: 2) location: 18 @ 23.
		(players at: 3) location: 33 @ 18.
		^ self ].
	players size = 4 ifTrue: [
		(players at: 1) location: 16 @ 11.
		(players at: 2) location: 35 @ 11.
		(players at: 3) location: 16 @ 25.
		(players at: 4) location: 35 @ 25.
		^ self ].
	self error: 'Invalid number of players.'
!

renderCanvasOn: aSilk
	^ aSilk CANVAS: {
		#width -> (size x * skin tileSize).
		#height -> (size y * skin tileSize)}.
!

startIfAllReady
	(livePlayers isEmpty not
		and: [ livePlayers allSatisfy: #isReady ])
			ifTrue: [ self startTimer ]
!

startTimer
	timerId ifNotNil: [ self error: 'Timer already running.' ].
	timerId := window setInterval: [ self update ] every: 75.
!

stopTimer
	timerId ifNotNil: [
		window clearInterval: timerId.
		timerId := nil ]
!

update
	| lpCopy |
	lpCopy := livePlayers copy.
	lpCopy do: [ :each |
		| l |
		l := each location.
		self at: l put: each move.
		skin drawField: self on: context at: l ].
	lpCopy do: [ :each |
		| l other |
		l := each location.
		(self isFreeAt: l)
			ifTrue: [ self at: l put: each headSegment. ]
			ifFalse: [
				self killPlayer: each.
				"Check for head-to-head collision."
				other := self playerWithHeadAt: l.
				(other isNil | (other = each))
					ifFalse: [ 
						self killPlayer: other.
						self at: l put: nil. ]]].
	livePlayers do: [ :each | 
		skin drawField: self on: context at: each location ].
	self isGameFinished ifTrue: [ ^ self endGame ].
	livePlayers do: #compute.
!

updateLiveColors
	liveColors := Dictionary new.
	livePlayers do: [ :each |
		liveColors
			at: each color
			ifPresent: [ :v | liveColors at: each color put: v + 1 ]
			ifAbsent: [ liveColors at: each color put: 1 ]].
! !

!TronField methodsFor: 'rendering'!

renderOnSilk: aSilk
	| backgroundCanvas |
	
	backgroundCanvas := (self renderCanvasOn: aSilk) element.
	
	canvas := (self renderCanvasOn: aSilk) element.
	context := canvas getContext: '2d'.
	
	collider := TronCollider new
		canvas: (self renderCanvasOn: aSilk) element;
		skin: skin.
	
	skin drawBackgroundOn: (backgroundCanvas getContext: '2d') from: 1 @ 1 to: size
! !

!TronField methodsFor: 'starting'!

start: anArrayOfPlayers
	players := anArrayOfPlayers.
	livePlayers := players copy.
	self updateLiveColors.
	colors := liveColors.
	matrix := (1 to: size y) collect: [ :i | Array new: size x ].
	context clearRect: 0 y: 0 w: canvas width h: canvas height.
	self locatePlayers.
	players do: [ :each | each field: self; reset; compute ].
	players do: [ :each |
		self at: each location put: each headSegment.
		skin drawField: self on: context at: each location ].
	self startIfAllReady.
! !

Object subclass: #TronPlayer
	instanceVariableNames: 'enabled color name controller segments location moved direction nextDirection onColorChange onEnabledChange onControllerChange'
	package: 'Serpentron'!

!TronPlayer methodsFor: 'accessing'!

color
	^ color
!

color: anObject
	color := anObject.
	onColorChange ifNotNil: #value.
!

controller
	^ controller
!

controller: aTronController
	aTronController player: self.
	controller := aTronController.
	onControllerChange ifNotNil: #value.
!

direction
	^ direction
!

enabled: aBoolean
	enabled := aBoolean.
	onEnabledChange ifNotNil: #value.
!

field: aField
	controller field: aField
!

headSegment
	^ segments at: direction
!

isEnabled
	^ enabled
!

isFirstMove
	^ moved not
!

isReady
	^ nextDirection notNil
!

location
	^ location
!

location: anObject
	location := anObject
!

name
	^ name
!

name: anObject
	name := anObject.
!

nextDirection
	^ nextDirection
!

nextDirection: aPoint
	moved ifFalse: [ direction := aPoint ].
	nextDirection := aPoint
! !

!TronPlayer methodsFor: 'event handling'!

keyDown: keyCode
	^ controller keyDown: keyCode
! !

!TronPlayer methodsFor: 'initialization'!

initialize
	super initialize.
	enabled := true.
	self reset; initializeSegments.
!

reset
	direction := 0 @ -1.
	nextDirection := nil.
	moved := false.
	controller ifNotNil: [ controller reset ].
! !

!TronPlayer methodsFor: 'observing'!

onColorChange: aBlock
	onColorChange := aBlock.
!

onControllerChange: aBlock
	onControllerChange := aBlock.
!

onEnabledChange: aBlock
	onEnabledChange := aBlock.
! !

!TronPlayer methodsFor: 'private'!

initializeSegments
	segments := Dictionary new.
	TronPlayer directionNames keysAndValuesDo: [ :to :toName |
		segments 
			at: to 
			put: (TronHead new 
					player: self;
					sprite: 'head', toName;
					direction: to);
			at: {to. to}
			put: (TronSegment new
					player: self;
					sprite: 'body', toName).
		TronPlayer directionNames keysAndValuesDo: [ :from :fromName |		
			(from x = to x) | (from y = to y) ifFalse: [
				segments
					at: {from. to}
					put: (TronSegment new
							player: self;
							sprite: 'body', fromName, 'To', toName) ]]].
! !

!TronPlayer methodsFor: 'updating'!

compute
	controller compute
!

move
	| segment |
	segment := segments at: {direction. nextDirection} ifAbsent: [ nil ].
	direction := nextDirection.
	location := location + direction.
	moved := true.
	^ segment
! !

TronPlayer class instanceVariableNames: 'directions directionNames'!

!TronPlayer class methodsFor: 'initialization'!

directionNames
	^ directionNames
!

directions
	^ directions
!

initialize
	super initialize.
	directionNames := Dictionary new
		at: 0 @ -1 put: 'North';
		at: 1 @ 0 put: 'East';
		at: 0 @ 1 put: 'South';
		at: -1 @ 0 put: 'West';
		yourself.
	directions := directionNames keys.
! !

Object subclass: #TronSegment
	instanceVariableNames: 'player sprite'
	package: 'Serpentron'!

!TronSegment methodsFor: 'accessing'!

color
	^ player color
!

isHead
	^ false
!

player
	^ player
!

player: anObject
	player := anObject
!

sprite
	^ sprite
!

sprite: anObject
	sprite := anObject
! !

TronSegment subclass: #TronHead
	instanceVariableNames: 'direction'
	package: 'Serpentron'!

!TronHead methodsFor: 'accessing'!

direction
	^ direction
!

direction: anObject
	direction := anObject
!

isHead
	^ true
! !

Object subclass: #TronSkin
	instanceVariableNames: 'skinMap skinImage tileSize maskOffset'
	package: 'Serpentron'!

!TronSkin methodsFor: 'accessing'!

tileSize
	^ tileSize
! !

!TronSkin methodsFor: 'drawing'!

drawBackgroundOn: aContext at: aPoint
	self drawTile: #background offset: aPoint - 1 on: aContext at: aPoint;
		 drawTile: #backgroundTile on: aContext at: aPoint
!

drawBackgroundOn: aContext from: nwPoint to: sePoint
	nwPoint y to: sePoint y do: [ :row |
		nwPoint x to: sePoint x do: [ :col |
			self drawBackgroundOn: aContext at: col @ row ]]
!

drawField: aField on: aContext at: aPoint
	| x y segment |
	
	x := (aPoint - 1) x * tileSize.
	y := (aPoint - 1) y * tileSize.
	
	aContext
		clearRect: x and: y and: tileSize and: tileSize.
	
	segment := (aField at: aPoint) ifNil: [ ^ self ].
	
	self 
		drawTile: segment sprite
		offset: maskOffset
		on: aContext
		at: aPoint.
	aContext
		globalCompositeOperation: 'source-atop';
		fillStyle: segment color;
		fillRect: x and: y and: tileSize and: tileSize.
	self drawTile: segment sprite on: aContext at: aPoint.
	
	aContext globalCompositeOperation: 'source-over'.
!

drawSkinImageOn: aContext source: sourcePoint destination: destinationPoint
	aContext drawImage: skinImage
		sx: sourcePoint x
		sy: sourcePoint y
		sw: tileSize
		sh: tileSize
		dx: destinationPoint x
		dy: destinationPoint y
		dw: tileSize
		dh: tileSize
!

drawTile: aSymbol offset: offsetPoint on: aContext at: targetPoint
	self 
		drawSkinImageOn: aContext
		source: ((skinMap at: aSymbol) + offsetPoint) * tileSize
		destination: (targetPoint - 1) * tileSize
!

drawTile: aSymbol on: aContext at: aPoint
	self drawTile: aSymbol offset: 0@0 on: aContext at: aPoint
! !

!TronSkin methodsFor: 'initialization'!

initialize
	super initialize.
	skinMap := Dictionary new
		at: #background put: 0@0;
		at: #backgroundBottomRight put: 49@34;
		at: #backgroundTile put: 0@35;
		at: #headNorth put: 1@35;
		at: #headEast put: 2@35;
		at: #headSouth put: 3@35;
		at: #headWest put: 4@35;
		at: #bodyNorth put: 5@35;
		at: #bodyEast put: 6@35;
		at: #bodySouth put: 7@35;
		at: #bodyWest put: 8@35;
		at: #bodySouthToEast put: 9@35;
		at: #bodyWestToNorth put: 9@35;
		at: #bodyNorthToEast put: 10@35;
		at: #bodyWestToSouth put: 10@35;
		at: #bodyNorthToWest put: 11@35;
		at: #bodyEastToSouth put: 11@35;
		at: #bodySouthToWest put: 12@35;
		at: #bodyEastToNorth put: 12@35;
		yourself.
	maskOffset := 12 @ 0.
	skinImage := document createElement: 'img'
! !

!TronSkin methodsFor: 'loading'!

load: url andDo: aBlock
	skinImage onload: [
		tileSize := skinImage width / 50.
		aBlock value ].
	skinImage src: url.
! !

!Point methodsFor: '*Serpentron'!

rotate90ccw
	^ self y @ self x negated
!

rotate90cw
	^ self y negated @ self x
! !