'From Squeak3.2alpha of 3 October 2001 [latest update: #4418] on 6 October 2001 at 9:12:36 pm'! "Change Set: SpaceWar Date: 6 October 2001 Author: Robert Hirschfeld I'm too young to have played the original game :-) So, there is no doubt that I must have missed some important details ... I got the idea from Stewart Brand's famous Spacwar article: *** http://www.wheels.org/spacewar/stone/rolling_stone.html *** http://www.prakinf.tu-ilmenau.de/~hirsch/Projects/Squeak/SpaceWar/"! Object subclass: #SwSpace instanceVariableNames: 'dimensions objects ' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpace class instanceVariableNames: ''! Morph subclass: #SwSpaceMorph instanceVariableNames: 'transform drawBlock fillColor borderColor ' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpaceMorph class instanceVariableNames: ''! SwSpaceMorph subclass: #SwSpaceObject instanceVariableNames: 'p v a radius energy spunk space colliding exploding ' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpaceObject subclass: #SwSpaceMine instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpaceMine class instanceVariableNames: ''! SwSpaceObject subclass: #SwSpaceShip instanceVariableNames: 'direction thrust steer hits ' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpaceShip class instanceVariableNames: ''! Morph subclass: #SwSpaceShipSteer instanceVariableNames: 'ship keyChars successor ' classVariableNames: 'KeyCharSets ' poolDictionaries: '' category: 'SpaceWar-Support'! SwSpaceShipSteer class instanceVariableNames: ''! SwSpaceObject subclass: #SwSpaceTorpedo instanceVariableNames: 'ship ' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Objects'! SwSpaceTorpedo class instanceVariableNames: ''! Object subclass: #SwSpaceWar instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Game'! SwSpaceWar class instanceVariableNames: ''! FloatArray variableWordSubclass: #SwVector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SpaceWar-Support'! SwVector class instanceVariableNames: ''! !SwSpace methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:22'! dimensions ^ dimensions! ! !SwSpace methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:22'! dimensions: aSwVector dimensions _ aSwVector.! ! !SwSpace methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:22'! objects ^ objects! ! !SwSpace methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:22'! objects: aSet objects _ aSet.! ! !SwSpace methodsFor: 'adding-removing' stamp: 'rhi 6/27/2000 16:22'! add: aSwSpaceObject aSwSpaceObject space notNil ifTrue: [aSwSpaceObject space remove: aSwSpaceObject]. self objects add: aSwSpaceObject. aSwSpaceObject space: self.! ! !SwSpace methodsFor: 'adding-removing' stamp: 'rhi 6/27/2000 16:23'! remove: aSwSpaceObject aSwSpaceObject space == self ifTrue: [ aSwSpaceObject space: nil. self objects remove: aSwSpaceObject ifAbsent: []].! ! !SwSpace methodsFor: 'game' stamp: 'rhi 10/6/2001 20:20'! spaceWarShips: aShipsInteger mines: aMinesInteger | win trans dims ships mines | "=== build the base window ... ===" win _ SystemWindow labelled: 'SpaceWar'. self flag: #rhi. "Shared spaces better have same dimensions." self flag: #rhi. "Need to disable RESIZE-HALO!!" "win allowReframeHandles: false." "=== build ships and mines ... ===" dims _ Rectangle origin: 0@0 corner: self dimensions asPoint. ships _ OrderedCollection new. 1 to: (aShipsInteger min: SwSpaceShipSteer keyCharSets size) do: [:i | | ship | ship _ SwSpaceShip new. ship steer keyChars: (ship steer keyCharSets at: i). ship setBalloonText. ship randomPositionIn: dims. ships add: ship. self add: ship]. 2 to: ships size do: [:i | (ships at: i - 1) steer successor: (ships at: i) steer]. mines _ OrderedCollection new. aMinesInteger timesRepeat: [ | mine | mine _ SwSpaceMine new. mine randomPositionIn: dims. mines add: mine. self add: mine]. "=== set-up transforms ... ===" trans _ TransformMorph new. trans color: Color black. ships, mines do: [:spaceObject | trans addMorph: spaceObject transform]. "=== populate window ... ===" ships reverseDo: [:ship | win addMorph: ship steer frame: (0.0@0.0 extent: 1.0@1.0)]. win addMorph: trans frame: (0.0@0.0 extent: 1.0@1.0). "=== open window ... ===" win color: Color black; openInWorldExtent: self dimensions asPoint. "=== get the space objects going ... ===" ships, mines do: [:aSpaceObject | aSpaceObject startStepping].! ! !SwSpace methodsFor: 'geometry' stamp: 'rhi 6/27/2000 16:23'! defaultDimensions ^ self class defaultDimensions! ! !SwSpace methodsFor: 'initialization' stamp: 'rhi 6/27/2000 16:24'! initialize self dimensions: self defaultDimensions; objects: Set new.! ! !SwSpace class methodsFor: 'geometry' stamp: 'rhi 6/27/2000 16:24'! defaultDimensions ^ SwVector x: 600 y: 600! ! !SwSpace class methodsFor: 'instance creation' stamp: 'rhi 6/27/2000 16:24'! new ^ super new initialize! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! borderColor ^ borderColor! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! borderColor: aColor borderColor _ aColor.! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! drawBlock ^ drawBlock! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! drawBlock: aBlockContext drawBlock _ aBlockContext.! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! fillColor ^ fillColor! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! fillColor: aColor fillColor _ aColor.! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! transform ^ transform! ! !SwSpaceMorph methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:30'! transform: aTransformationMorph transform _ aTransformationMorph.! ! !SwSpaceMorph methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:30'! drawOn: aCanvas self drawBlock value: aCanvas.! ! !SwSpaceMorph methodsFor: 'initialization' stamp: 'rhi 6/27/2000 16:31'! initialize super initialize. self color: Color transparent; transform: (TransformationMorph new asFlexOf: self); drawBlock: [:aCanvas | self subclassResponsibility]; "!!!!!!" fillColor: self class fillColor; borderColor: self class borderColor.! ! !SwSpaceMorph methodsFor: 'submorphs-add/remove' stamp: 'rhi 6/27/2000 16:31'! delete ((self transform == self owner) and: [self transform ~~ nil]) ifTrue: [self transform delete] ifFalse: [super delete].! ! !SwSpaceMorph class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:29'! borderColor self subclassResponsibility.! ! !SwSpaceMorph class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:30'! fillColor self subclassResponsibility.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:31'! a ^ a! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! a: aSwVector a _ aSwVector.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! colliding ^ colliding! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! colliding: aBoolean colliding _ aBoolean.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! energy ^ energy! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! energy: anInteger energy _ anInteger.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! exploding ^ exploding! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! exploding: aBoolean exploding _ aBoolean.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! p ^ p! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:32'! p: aSwVector p _ aSwVector.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! radius ^ radius! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! radius: anInteger radius _ anInteger.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! space ^ space! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! space: aSwSpace space _ aSwSpace.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! spunk ^ spunk! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! spunk: anInteger spunk _ anInteger.! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:33'! v ^ v! ! !SwSpaceObject methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:34'! v: aSwVector v _ aSwVector.! ! !SwSpaceObject methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:34'! explodeDrawBlock ^ [:aCanvas | | x0 y0 x1 y1 d dx dy | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. dx _ x1 - x0 / 8. dy _ y1 - y0 / 8. aCanvas drawPolygon: ({ x0 @ y0. (x0 + (3 * dx)) @ (y0 + (2 * dy)). (x0 + (4 * dx))@ y0. (x0 + (5 * dx)) @ (y0 + (2 * dy)). x1 @ y0. (x0 + (6 * dx)) @ (y0 + (3 * dy)). x1 @ (y0 + (4 * dy)). (x0 + (6 * dx)) @ (y0 + (5 * dy)). x1 @ y1. (x0 + (5 * dx)) @ (y0 + (6 * dy)). (x0 + (4 * dx)) @ y1. (x0 + (3 * dx)) @ (y0 + (6 * dy)). x0 @ y1. (x0 + (2 * dx)) @ (y0 + (5 * dy)). x0 @ (y0 + (4 * dy)). (x0 + (2 * dx)) @ (y0 + (3 * dy)). } collect: [:point | point asIntegerPoint]) color: Color yellow borderWidth: 1 borderColor: self borderColor]! ! !SwSpaceObject methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:34'! regularDrawBlock self subclassResponsibility.! ! !SwSpaceObject methodsFor: 'drawing' stamp: 'rhi 6/27/2000 23:52'! shakeDrawBlock self subclassResponsibility.! ! !SwSpaceObject methodsFor: 'initialization' stamp: 'rhi 6/27/2000 16:34'! initialize super initialize. self drawBlock: self regularDrawBlock; p: (SwVector x: 0 y: 0); v: (SwVector x: 0 y: 0); a: (SwVector x: 0 y: 0); radius: 0; "default sensitivity is none" energy: 1; "to be adjusted by subclasses" spunk: 1; "to be adjusted by subclasses" space: nil; colliding: false; exploding: false.! ! !SwSpaceObject methodsFor: 'sensitivity' stamp: 'rhi 6/27/2000 16:34'! radiusFromExtent ^ (self extent x + self extent y) / 4! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 18:23'! collideWith: aSwSpaceObject aSwSpaceObject colliding ifFalse: [ aSwSpaceObject colliding: true; decreaseEnergyOf: self]. self colliding ifFalse: [ self colliding: true; decreaseEnergyOf: aSwSpaceObject].! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! decreaseEnergyOf: aSwSpaceObject aSwSpaceObject energy: aSwSpaceObject energy - self spunk.! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! detectCollisions "previously used Morph>>color:sees: wich appeared to be too slow ... self colliding: (self colliding or: [self color: self borderColor sees: * borderColor])" self space notNil ifTrue: [ self space objects do: [:obj | | diff | diff _ self p - obj p. (self radius + obj radius) squared >= (diff x squared + diff y squared) ifTrue: [self collideWith: obj]] without: self].! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! eternalize self space remove: self. self stopStepping; delete.! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! explode self exploding: true; drawBlock: self explodeDrawBlock; beep; changed.! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! move self subclassResponsibility.! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:48'! randomPositionIn: aRectangle | extent | extent _ aRectangle extent. self p x: extent x asInteger atRandom. self p y: extent y asInteger atRandom. self transform center: self p asPoint.! ! !SwSpaceObject methodsFor: 'spacing' stamp: 'rhi 6/27/2000 16:35'! shake self colliding: false; drawBlock: self shakeDrawBlock; beep; changed.! ! !SwSpaceObject methodsFor: 'stepping' stamp: 'rhi 6/27/2000 18:38'! step self exploding ifTrue: [self eternalize] ifFalse: [ self colliding ifTrue: [ self energy > 0 ifTrue: [self shake] ifFalse: [self explode]] ifFalse: [ self move. self detectCollisions. self colliding ifTrue: [ self energy > 0 ifTrue: [self shake] ifFalse: [self explode]]]].! ! !SwSpaceObject methodsFor: 'stepping' stamp: 'rhi 6/27/2000 16:35'! stepTime ^ 0! ! !SwSpaceMine methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:36'! regularDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 width | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) // 2). ym _ y0 + ((y1 - y0) // 2). width _ 1. aCanvas line: x0@y0 to: x1@y1 width: width color: self borderColor; line: x1@y0 to: x0@y1 width: width color: self borderColor; line: xm@y0 to: xm@y1 width: width color: self borderColor; line: x0@ym to: x1@ym width: width color: self borderColor]! ! !SwSpaceMine methodsFor: 'drawing' stamp: 'rhi 6/28/2000 01:46'! shakeDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 width | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) // 2). ym _ y0 + ((y1 - y0) // 2). width _ 2. aCanvas line: x0@y0 to: x1@y1 width: width color: self borderColor; line: x1@y0 to: x0@y1 width: width color: self borderColor; line: xm@y0 to: xm@y1 width: width color: self borderColor; line: x0@ym to: x1@ym width: width color: self borderColor]! ! !SwSpaceMine methodsFor: 'initialization' stamp: 'rhi 6/27/2000 16:36'! initialize super initialize. self extent: 10@10; radius: self radiusFromExtent; spunk: 50.! ! !SwSpaceMine methodsFor: 'spacing' stamp: 'rhi 6/27/2000 23:58'! move "Mines don't move in this space quadrant." self drawBlock: self regularDrawBlock.! ! !SwSpaceMine class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:36'! borderColor ^ Color red! ! !SwSpaceMine class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:36'! fillColor ^ Color transparent! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:39'! direction ^ direction! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:39'! direction: anInteger direction _ anInteger.! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:39'! hits ^ hits! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:39'! hits: anInteger hits _ anInteger.! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:39'! steer ^ steer! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:40'! steer: aSwSpaceShipSteer steer _ aSwSpaceShipSteer.! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:40'! thrust ^ thrust! ! !SwSpaceShip methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:40'! thrust: anInteger thrust _ anInteger.! ! !SwSpaceShip methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:40'! negativeThrustDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 xf | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) / 3). ym _ y0 + ((y1 - y0) / 2). xf _ x0 + ((x1 - x0) * 2 / 3). aCanvas drawPolygon: ({ x0@y0. x1@ym. x0@y1. xm@ym. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor. aCanvas line: (xf@ym) asIntegerPoint to: (x1@(y0 + ym // 2)) asIntegerPoint width: 2 color: self class thrustColor; line: (xf@ym) asIntegerPoint to: (x1@(ym + y1 // 2)) asIntegerPoint width: 2 color: self class thrustColor]! ! !SwSpaceShip methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:40'! positiveThrustDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) / 3). ym _ y0 + ((y1 - y0) / 2). aCanvas drawPolygon: ({ x0@y0. x1@ym. x0@y1. xm@ym. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor. aCanvas line: (x0@ym) asIntegerPoint to: ((x0 + xm // 2)@(y0 + ym // 2)) asIntegerPoint width: 2 color: self class thrustColor; line: (x0@ym) asIntegerPoint to: ((x0 + xm // 2)@(ym + y1 // 2)) asIntegerPoint width: 2 color: self class thrustColor]! ! !SwSpaceShip methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:40'! regularDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) / 3). ym _ y0 + ((y1 - y0) / 2). aCanvas drawPolygon: ({ x0@y0. x1@ym. x0@y1. xm@ym. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor]! ! !SwSpaceShip methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:40'! shakeDrawBlock ^ [:aCanvas | | x0 y0 xm ym x1 y1 yy | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. xm _ x0 + ((x1 - x0) / 3). ym _ y0 + ((y1 - y0) / 2). yy _ { y0. ym. y1. }. 1 to: yy size do: [:i | "(Delay forMilliseconds: 10) wait." aCanvas drawPolygon: ({ x0@y0. x1@(yy at: i). x0@y1. xm@ym. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor]]! ! !SwSpaceShip methodsFor: 'halos and balloon help' stamp: 'rhi 6/27/2000 18:13'! balloonText ^ (WriteStream on: String new) nextPutAll: 'HITS: '; nextPutAll: self hits printString; nextPut: Character cr; nextPutAll: (self steer keyChars inject: 'STEER:' into: [:str :c | str, ' ', (Character value: c) asString]); contents! ! !SwSpaceShip methodsFor: 'halos and balloon help' stamp: 'rhi 6/27/2000 17:18'! setBalloonText self setBalloonText: self balloonText.! ! !SwSpaceShip methodsFor: 'initialization' stamp: 'rhi 11/24/2000 00:14'! initialize super initialize. self extent: 40@15; radius: self radiusFromExtent; p: (SwVector fromPoint: self extent // 2); energy: 100; spunk: 50; direction: 360 atRandom; thrust: 0; steer: SwSpaceShipSteer new; hits: 0. self transform rotationDegrees: self direction. self steer ship: self.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 11/24/2000 00:05'! accelerate (self thrust == 0) ifTrue: [ self a x: 0 y: 0. self drawBlock: self regularDrawBlock] ifFalse: [ | dirInRadians accelerationRadius | self flag: #rhi. "Factor-out constant!!" accelerationRadius _ 1. dirInRadians _ self direction degreesToRadians. self a x: accelerationRadius * dirInRadians cos y: accelerationRadius * dirInRadians sin. (self thrust < 0) ifTrue: [ self a: self a negated. self drawBlock: self negativeThrustDrawBlock] ifFalse: [ self drawBlock: self positiveThrustDrawBlock]. self thrust: 0].! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 11/24/2000 00:06'! fire | sDirInRads torpedo tInitialSpeed tDirInRads tDirInDegs distance delta | self flag: #rhi. "Factor-out constant!! Refactor!!" tInitialSpeed _ 10. sDirInRads _ self direction degreesToRadians. torpedo _ SwSpaceTorpedo new. torpedo ship: self; fillColor: self fillColor; v: self v + (SwVector x: tInitialSpeed * sDirInRads cos y: tInitialSpeed * sDirInRads sin). tDirInRads _ (torpedo v y / ((torpedo v y squared + torpedo v x squared) sqrt)) arcSin. distance _ (self extent x + torpedo extent x) / 2. delta _ SwVector x: distance * tDirInRads cos y: distance * tDirInRads sin. tDirInDegs _ tDirInRads radiansToDegrees. (torpedo v x < 0) ifTrue: [ delta x: delta x negated. (torpedo v y < 0) ifTrue: [tDirInDegs _ -180 - tDirInDegs] ifFalse: [tDirInDegs _ 180 - tDirInDegs]]. torpedo p: self p + delta. torpedo transform center: self transform center + delta asPoint; rotationDegrees: tDirInDegs. self owner owner addMorph: torpedo transform. self space add: torpedo. torpedo startStepping.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 10/6/2001 21:08'! move | spaceExtent vNew | self flag: #rhi. "How about self space dimensions (with disabled RESIZE-HALO) ?!!?" spaceExtent _ self owner owner extent. "Hier koennen wir besser werden ..." self accelerate. vNew _ self v + self a. (vNew radiusSquared <= self vMaxSquared) ifTrue: [self v: vNew]. self p: self p + self v \\ { spaceExtent x. spaceExtent y. }. self transform rotationDegrees: self direction; center: self transform center + self v asPoint \\ spaceExtent.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 11/24/2000 00:07'! negativeThrust self flag: #rhi. "Factor-out constant!!" self thrust: -1.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 11/24/2000 00:07'! positiveThrust self flag: #rhi. "Factor-out constant!!" self thrust: 1.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 1/25/2001 22:15'! turnLeft self flag: #rhi. "Factor-out constant!!" self direction: (self direction - 10) asSmallAngleDegrees.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 1/25/2001 22:15'! turnRight self flag: #rhi. "Factor-out constant!!" self direction: (self direction + 10) asSmallAngleDegrees.! ! !SwSpaceShip methodsFor: 'spacing' stamp: 'rhi 10/6/2001 21:03'! vMaxSquared ^ 676! ! !SwSpaceShip methodsFor: 'submorphs-add/remove' stamp: 'rhi 6/27/2000 16:41'! delete super delete. self steer ship: nil.! ! !SwSpaceShip class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:39'! borderColor ^ Color yellow! ! !SwSpaceShip class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:39'! fillColor ^ Color random! ! !SwSpaceShip class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:39'! thrustColor ^ Color orange! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! keyChars ^ keyChars! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! keyChars: aSequenceableCollection keyChars _ aSequenceableCollection.! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! ship ^ ship! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! ship: aSwSpaceShip ship _ aSwSpaceShip.! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! successor ^ successor! ! !SwSpaceShipSteer methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:25'! successor: aSwSpaceShipSteer successor _ aSwSpaceShipSteer.! ! !SwSpaceShipSteer methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:25'! drawOn: aCanvas aCanvas fillRectangle: self bounds color: Color transparent.! ! !SwSpaceShipSteer methodsFor: 'event handling' stamp: 'rhi 6/27/2000 16:25'! handlesMouseOver: aMorphicEvent ^ true! ! !SwSpaceShipSteer methodsFor: 'event handling' stamp: 'rhi 6/27/2000 16:25'! keyCharSets ^ self class keyCharSets! ! !SwSpaceShipSteer methodsFor: 'event handling' stamp: 'rhi 11/21/2000 23:32'! keyStroke: aMorphicEvent | keyCharValue | keyCharValue _ aMorphicEvent keyCharacter asciiValue. (keyCharValue = (self keyChars at: 1)) ifTrue: [^ self ship notNil ifTrue: [self ship turnLeft]]. (keyCharValue = (self keyChars at: 2)) ifTrue: [^ self ship notNil ifTrue: [self ship turnRight]]. (keyCharValue = (self keyChars at: 3)) ifTrue: [^ self ship notNil ifTrue: [self ship positiveThrust]]. (keyCharValue = (self keyChars at: 4)) ifTrue: [^ self ship notNil ifTrue: [self ship negativeThrust]]. (keyCharValue = (self keyChars at: 5)) ifTrue: [^ self ship notNil ifTrue: [self ship fire]]. self successor notNil ifTrue: [self successor keyStroke: aMorphicEvent].! ! !SwSpaceShipSteer methodsFor: 'event handling' stamp: 'rhi 6/27/2000 16:26'! mouseEnter: aMorphicEvent super mouseEnter: aMorphicEvent. aMorphicEvent hand newKeyboardFocus: self.! ! !SwSpaceShipSteer methodsFor: 'initialization' stamp: 'rhi 11/21/2000 23:32'! initialize super initialize. self ship: nil; successor: nil; keyChars: (self keyCharSets at: 1); eventHandler: (EventHandler new on: #keyStroke send: #keyStroke: to: self).! ! !SwSpaceShipSteer class methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:24'! keyCharSets ^ KeyCharSets! ! !SwSpaceShipSteer class methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:24'! keyCharSets: aSequenceableCollection KeyCharSets _ aSequenceableCollection.! ! !SwSpaceShipSteer class methodsFor: 'class initialization' stamp: 'rhi 6/28/2000 11:28'! defaultKeyChars ^ { 28. "Cursor left - turn left" 29. "Cursor right - turn right" 30. "Cursor up - positive thrust" 31. "Cursor down - negative thrust" 32. "Space - fire" }! ! !SwSpaceShipSteer class methodsFor: 'class initialization' stamp: 'rhi 6/27/2000 16:24'! initialize "doIt: [self initialize]" self keyCharSets: { self defaultKeyChars. self keyCharsTwo. self keyCharsThree. }.! ! !SwSpaceShipSteer class methodsFor: 'class initialization' stamp: 'rhi 6/28/2000 11:26'! keyCharsThree ^ { 103. "g - turn left" 106. "j - turn right" 121. "y - positive thrust" 104. "h - negative thrust" 116. "t - fire" }! ! !SwSpaceShipSteer class methodsFor: 'class initialization' stamp: 'rhi 6/28/2000 11:26'! keyCharsTwo ^ { 113. "q - turn left" 101. "e - turn right" 50. "2 - positive thrust" 119. "w - negative thrust" 49. "1 - fire" }! ! !SwSpaceTorpedo methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:37'! ship ^ ship! ! !SwSpaceTorpedo methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:37'! ship: aSwSpaceShip ship _ aSwSpaceShip.! ! !SwSpaceTorpedo methodsFor: 'drawing' stamp: 'rhi 6/27/2000 16:37'! regularDrawBlock ^ [:aCanvas | | x0 y0 ym x1 y1 | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. ym _ y0 + ((y1 - y0) // 2). aCanvas drawPolygon: ({ x0@y0. x1@ym. x0@y1. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor]! ! !SwSpaceTorpedo methodsFor: 'drawing' stamp: 'rhi 6/27/2000 23:51'! shakeDrawBlock ^ [:aCanvas | | x0 y0 ym x1 y1 yy | x0 _ self bounds topLeft x. y0 _ self bounds topLeft y. x1 _ self bounds bottomRight x. y1 _ self bounds bottomRight y. ym _ y0 + ((y1 - y0) // 2). yy _ { y0. ym. y1. }. 1 to: yy size do: [:i | "(Delay forMilliseconds: 10) wait." aCanvas drawPolygon: ({ x0@y0. x1@(yy at: i). x0@y1. } collect: [:point | point asIntegerPoint]) color: self fillColor borderWidth: 1 borderColor: self borderColor]]! ! !SwSpaceTorpedo methodsFor: 'initialization' stamp: 'rhi 6/27/2000 16:44'! initialize super initialize. self ship: nil; extent: 20@5; radius: self radiusFromExtent; spunk: 40.! ! !SwSpaceTorpedo methodsFor: 'spacing' stamp: 'rhi 6/27/2000 18:11'! collideWith: aSwSpaceObject super collideWith: aSwSpaceObject. (aSwSpaceObject isKindOf: SwSpaceShip) ifTrue: [ self ship hits: self ship hits + 1. self ship setBalloonText].! ! !SwSpaceTorpedo methodsFor: 'spacing' stamp: 'rhi 11/23/2000 22:14'! move | spaceExtent | self flag: #rhi. "How about self space dimensions (with disabled RESIZE-HALO) ?!!?" spaceExtent _ self owner owner extent. "Hier koennen wir besser werden ..." self drawBlock: self regularDrawBlock. self v: self v + self a. self p: self p + self v. self transform center: self transform center + self v asPoint. (self p x < 0 or: [self p x > spaceExtent x or: [self p y < 0 or: [self p y > spaceExtent y]]]) ifTrue: [self eternalize].! ! !SwSpaceTorpedo class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:37'! borderColor ^ Color red! ! !SwSpaceTorpedo class methodsFor: 'colors' stamp: 'rhi 6/27/2000 16:37'! fillColor ^ Color transparent! ! !SwSpaceWar class methodsFor: 'game' stamp: 'rhi 6/27/2000 16:21'! spaceWar "doIt: [self spaceWar]" self spaceWarShips: 2 mines: 0.! ! !SwSpaceWar class methodsFor: 'game' stamp: 'rhi 6/27/2000 16:21'! spaceWarShips: aShipsInteger mines: aMinesInteger "doIt: [self spaceWarShips: 2 mines: 0]" "doIt: [self spaceWarShips: 3 mines: 7]" "doIt: [self spaceWarShips: 7 mines: 13]" SwSpace new spaceWarShips: aShipsInteger mines: aMinesInteger.! ! !SwVector methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:28'! x ^ self at: 1! ! !SwVector methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:28'! x: aFloat self at: 1 put: aFloat! ! !SwVector methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:29'! x: aXFloat y: aYFloat self x: aXFloat; y: aYFloat.! ! !SwVector methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:29'! y ^ self at: 2! ! !SwVector methodsFor: 'accessing' stamp: 'rhi 6/27/2000 16:29'! y: aFloat self at: 2 put: aFloat! ! !SwVector methodsFor: 'converting' stamp: 'rhi 6/27/2000 16:29'! asPoint ^ self x @ self y! ! !SwVector methodsFor: 'derived accessing' stamp: 'rhi 10/6/2001 20:49'! radiusSquared ^ self x squared + self y squared! ! !SwVector class methodsFor: 'instance creation' stamp: 'rhi 6/27/2000 16:29'! fromPoint: aPoint ^ self x: aPoint x y: aPoint y! ! !SwVector class methodsFor: 'instance creation' stamp: 'rhi 6/27/2000 16:29'! x: aXFloat y: aYFloat ^ (self new: 2) x: aXFloat y: aYFloat! ! SwSpaceShipSteer initialize!