'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 23 December 2006 at 6:23:22 pm'! Smalltalk renameClassNamed: #Grid2ParcelSpace as: #GridParcelSpace! TSpace subclass: #GridParcelSpace instanceVariableNames: 'xloc yloc things inWest inNorth inEast inSouth radius' classVariableNames: '' poolDictionaries: '' category: 'Strick-Grid2'! Smalltalk renameClassNamed: #Grid2Participant as: #GridParticipant! KCroquetParticipant subclass: #GridParticipant instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Strick-Grid2'! Smalltalk renameClassNamed: #GridWorld as: #GridWorld! WisconsinWorld subclass: #GridWorld instanceVariableNames: 'xSize ySize parcels parcelRadius gridScale' classVariableNames: '' poolDictionaries: '' category: 'Strick-Grid2'! !GridWorld commentStamp: 'strick 12/18/2006 20:41' prior: 0! TODO -- GParcelSpace probably needs links back to GridWorld -- GridPortal tells GWorld when they open and close, which closes stuff behind you -- GridPortal open/close is not a persisent, replicated feature. -- So maybe a local hack on the Renderer is more approprite -- a new kind of TGroup, in which only some spaces are mapped? -- Or at least thinner, decorationless Portal Windows ! !Object methodsFor: '*Strick' stamp: 'strick 12/12/2006 19:45'! say " 'blah' say " | f | f := StandardFileStream fileNamed: '/proc/self/fd/2'. f nextPutAll: '# ', self asString, String lf. f close. ! ! !Object methodsFor: '*Strick' stamp: 'strick 12/12/2006 22:11'! say: foo " 'blah' say: 'foo' " | f | f := StandardFileStream fileNamed: '/proc/self/fd/2'. f nextPutAll: '# ', self asString, ' :: ', foo asString, String lf. f close. ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 02:33'! inEast ^ inEast! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:47'! initializeWithRadius: radius "For things, Z is up. The following rotation maps things to Croquet's system, where Y is up." things := TGroup new. things addRotationAroundX: 270. self addChild: things. "Postcards (really, empty TGroups) for Entrances from the four edge neighbors" inWest := TGroup new. inNorth := TGroup new. inEast := TGroup new. inSouth := TGroup new. inEast addRotationAroundY: 90. inNorth addRotationAroundY: 180. inWest addRotationAroundY: 270. inEast translationX: radius y: 0 z: 0. inWest translationX: radius negated y: 0 z: 0. inNorth translationX: 0 y: 0 z: radius negated. inSouth translationX: 0 y: 0 z: radius. self addChild: inWest. self addChild: inNorth. self addChild: inEast. self addChild: inSouth. ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 02:33'! inNorth ^ inNorth! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 02:33'! inSouth ^ inSouth! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 02:33'! inWest ^ inWest! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 12/16/2006 22:07'! things " things is a TGroup, for holding all the things, with Z axis going up " ^ things! ! !KCroquetParticipant methodsFor: 'accessing' stamp: 'strick 12/17/2006 00:58'! entry ^entry ifNil: [self entryWorld: GridWorld. entry]. ! ! !KCroquetParticipant class methodsFor: 'accessing' stamp: 'strick 12/16/2006 02:23'! defaultRouterAddress ^ RouterAddress ifNil: [ KMessageRouter dispatcher ifNotNil: ['127.0.0.1' "NetNameResolver localAddressString"] ifNil: [ "-----(UIManager default request: 'Enter interactivity server address, or leave blank to run your own locally.' initialAnswer: 'www.croquetcollaborative.org')-----" '' ifEmpty: [KMessageRouter runRouters] ifNotEmpty: [:x|x]. ] ]! ! !KCroquetParticipant class methodsFor: 'accessing' stamp: 'strick 12/23/2006 18:14'! worlds ^ Worlds ifNil: [ {UWIntroWorld. DungeonWorld. MarsWorld. UWSpreadSheetWorld. T3BodyWorld. UWUnderwaterWorld. WisconsinWorld. CritiquetWorld. QuiltersWorld. ForensicsWorld. WisconsinNextWorld1. WisconsinNextWorld2. GridWorld. } ] ! ! !KMessageRouter class methodsFor: 'running' stamp: 'strick 12/13/2006 00:47'! runRouters: port serverName: serverName serverPassword: serverPassword log: logging | router | Dispatcher ifNotNil: [^nil]. Dispatcher := TExampleDispatcher new. Dispatcher listenOn: port. Dispatcher autoCreate: false. router := KCacheRouter new. router autoStop: false. logging ifTrue: [router log: (self logDirectory forceNewFileNamed: 'cache.log')]. router logMessage: 'Starting'. router addUser: (KMessageRouterUser localCacheNamed: 'global' password: 'cache'). Dispatcher addRouter: router id: KCacheRouter defaultRouterID. KCroquetParticipant worlds do: [:ctrl | router := self new. logging ifTrue: [router log: (self logDirectory forceNewFileNamed: ctrl name, '.log')]. router autoStop: false; logMessage: 'Starting'; addGuest: 'guest' password: 'guest'; addParticipant: 'howard' password: 'stearns'; addParticipant: 'joshua' password: 'gargus'; addParticipant: 'jack' password: 'keel'; addParticipant: 'everyone' password: 'else'; addServer: serverName password: serverPassword. Dispatcher addRouter: router id: ctrl islandID. ]. ^ '127.0.0.1' "NetNameResolver localAddressString" ! ! !OpenAL methodsFor: 'testing' stamp: 'strick 12/11/2006 18:34'! isCurrent (self hasContext and: [self alcGetCurrentContext notNil]) ifTrue: [ ^ (handle getHandle) = ((self alcGetCurrentContext) getHandle) ] ifFalse: [ ^ false "strick guesses that false is the correct fallback" ] ! ! !WisconsinWorld methodsFor: 'initialize' stamp: 'strick 12/15/2006 21:59'! initializeToys: space self makeOnePortal: WisconsinNextWorld1 textureFileName: 'caust31.BMP' scale: 3 position: -25@0@-20 space: space. self makeOnePortal: ForensicsWorld textureFileName: 'graph128.bmp' scale: 2 position: -15@0@-20 space: space. self makeOnePortal: UWIntroWorld textureFileName: 'GrnChplTwr.bmp' scale: 2 position: -5@0@-20 space: space. self makeOnePortal: QuiltersWorld textureFileName: 'checker.png' scale: 2 position: 5@0@-20 space: space. self makeOnePortal: CritiquetWorld textureFileName: 'default.bmp' scale: 4 position: 15@0@-20 space: space. self makeOnePortal: WisconsinNextWorld2 textureFileName: 'floor.bmp' scale: 2 position: 25@0@-20 space: space. self makeOnePortal: GridWorld textureFileName: 'floor.bmp' scale: 3 position: 0@5@-18 space: space. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2006 20:48'! createAxes: space 4 to: 100 by: 4 do: [ :i | | b | b := TCube new. b colorize: Color black. b scale: 0.3; translation: i @ 0 @ 0. space addChild: b. ]. 4 to: 100 by: 4 do: [ :i | | b | b := TCube new. b colorize: Color yellow. b scale: 0.3; translation: 0 @ i @ 0. space addChild: b. ]. 4 to: 100 by: 4 do: [ :i | | b | b := TCube new. b colorize: Color white. b scale: 0.3; translation: 0 @ 0 @ i. space addChild: b. ]. space addChild: TFrame new. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2006 18:23'! initialize | space sky floor | "CONFIGRUABLE CONSTANTS" parcelRadius := 50. "half the length of a parcel edge" gridScale := 2. "doubles the apparent size of the spaces" "space" space := TSpace new. space registerGlobal: #mainEntry. "light" self makeLight: space. "floor" floor := self makeFloor: space fileName: 'lawn.bmp'. floor extentX: 100 y:0.5 z: 100. "sky" sky := TSkyBox new initializeWithFileName: 'GRS'. sky step. "get going" space addChild: sky. "toys" self makePyramid: space. "self makeMirror: space." self initializeCommonPortals: space. self createAxes: space. "parcels" self initializeParcels: space. self linkParcels. ^ space! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:48'! initializeParcels: space xSize := 3. ySize := 3. parcels := Dictionary new. self makeRingOfCubes: space. 0 to: xSize-1 do: [ :x | 0 to: ySize-1 do: [ :y | | s p w b | s := nil. s := GridParcelSpace new initializeWithRadius: parcelRadius. self makeRingOfCubesInNewCoords: s things. self createAxes: s things. w := self makePortal: 'lawn.bmp'. p := w contents. p postcardLink: s postcard. w extent: 5@5. w translation: (10*x-17) @ 0 @ (0-10*y-15). space addChild: w. self initializeCommonPortals: s. self makeFloor: s fileName: 'lawn.bmp'. self makeLight: s. parcels at: x@y put: s. b := TCube new. b translation: (10*x) @ 6 @ (10*y-30). b colorize: Color red. space addChild: b. ]. ]. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:42'! linkParcels 0 to: xSize-1 do: [ :x | 0 to: ySize-1 do: [ :y | | from to w p | from := parcels at: x@y. "-- make landmarks in parcel --" 0 to: x do: [ :i | | b | "red for x" b := TCube new. b colorize: Color red. b translation: -5 @ (1+i*1.5) @ -15. from addChild: b. ]. 0 to: y do: [ :i | | b | "blue for y" b := TCube new. b colorize: Color blue. b translation: -3 @ (1+i*1.5) @ -15. from addChild: b. ]. "-- now the actual edge portals --" to := parcels at: (x+1\\xSize) @ y. w := self makePortal: 'graph128.bmp'. w translation: parcelRadius @ 0 @ 0 . w addRotationAroundY: 270. w extent: (2 * parcelRadius) @ 10. p := w contents. p postcardLink: to inWest. from addChild: w. to := parcels at: (x+xSize-1\\xSize) @ y. w := self makePortal: 'graph128.bmp'. w translation: parcelRadius negated @ 0 @ 0 . w addRotationAroundY: 90. w extent: (2 * parcelRadius) @ 10. p := w contents. p postcardLink: to inEast. from addChild: w. to := parcels at: x @ (y+1\\ySize). w := self makePortal: 'graph128.bmp'. w translation: 0 @ 0 @ parcelRadius negated. w addRotationAroundY: 0. w extent: (2 * parcelRadius) @ 10. p := w contents. p postcardLink: to inSouth. from addChild: w. to := parcels at: y @ (y+ySize-1\\ySize). w := self makePortal: 'graph128.bmp'. w translation: 0 @ 0 @ parcelRadius . w addRotationAroundY: 180. w extent: (2 * parcelRadius) @ 10. p := w contents. p postcardLink: to inNorth. from addChild: w. ] ] ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:37'! makeCubes: sp 1 to: 10 do: [ :i | | c | c := TCube new. c colorize: Color blue. c translation: (i) @ (i*2) @ (i*4). sp addChild: c ] ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:21'! makeLight: sp | light tframe | light := TLight new. tframe := TSpinner new. tframe translationX: -10 y:0.0 z: 0.0. tframe rotationAroundZ: 120. "This is to avoid some odd lighting effects" tframe rotateBy: 1 around: 1@0@0. tframe matNil. tframe contents: light. sp addChild: tframe.! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:21'! makeMinimalPortal: textureName | p1 win pic | p1 := TPortal new. win := self makeMinimalWindow. win contents: p1. textureName ifNotNil:[ pic := TTexture new initializeWithFileName: textureName mipmap: true shrinkFit: false. win rectFront: pic. ]. win closeContents. win showOpenButton. ^win! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:18'! makeMinimalWindow ^ TWindow new.! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:21'! makeMirror: sp | win | win := self makePortal: nil. win translationX: -1 y:0 z: -8. sp addChild: win. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:22'! makePyramid: sp | pyr matNorm spinner | pyr := TSierpinski new. matNorm := TMaterial new. matNorm ambientColor: #(0.5 0.7 0.7 0.5). matNorm diffuseColor: #(0.5 0.7 0.7 0.5). pyr material: matNorm. pyr scale: 5.0. pyr depth: 3. spinner := TSpinner new. spinner translationX: 12 y:0 z: 12. spinner contents: pyr. sp addChild: spinner. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2006 03:39'! makeRingOfCubesInNewCoords: sp | r | r := parcelRadius/2. r negated to: r by: (r/4) do: [ :i | | c | c := TCube new. c translation: r @ i @ 0. sp addChild: c. c := TCube new. c translation: r negated @ i @ 0. sp addChild: c. c := TCube new. c translation: i @ r @ 0. sp addChild: c. c := TCube new. c translation: i @ r negated @ 0. sp addChild: c. ] ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/16/2006 01:55'! makeRingOfCubes: sp 20 negated to: 21 by: 4 do: [ :i | | c | c := TCube new. c translation: 20 @ 0 @ i. sp addChild: c. c := TCube new. c translation: 20 negated @ 0 @ i. sp addChild: c. c := TCube new. c translation: i @ 0 @ 20. sp addChild: c. c := TCube new. c translation: i @ 0 @ 20 negated. sp addChild: c. ] ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/14/2006 03:36'! makeThings: sp class: aTFrameClass 1 to: 10 do: [ :i | 1 to: 12 do: [ :j | | c | c := aTFrameClass new. c colorize: (Color r: i/11.0 g: 1.0 b: j/13.0). c translation: (i) @ (j*2) @ (i+j*4). sp addChild: c ] ] "--------- | pyr matNorm spinner | pyr := TSierpinski new. matNorm := TMaterial new. matNorm ambientColor: #(0.5 0.7 0.7 0.5). matNorm diffuseColor: #(0.5 0.7 0.7 0.5). pyr material: matNorm. pyr scale: 5.0. pyr depth: 3. spinner := TSpinner new. spinner translationX: 12 y:0 z: 12. spinner contents: pyr. sp addChild: spinner. ---"! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2006 20:48'! makeThings: sp class: aTFrameClass offset: offset scale: scale 1 to: 10 do: [ :i | 1 to: 12 do: [ :j | | c | c := aTFrameClass new. c colorize: (Color r: i/11.0 g: 1.0 b: j/13.0). c translation: ( (i) @ (j*2) @ (i+j*4) ) * scale + offset. sp addChild: c ] ] ! ! !GridWorld class methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:22'! islandID ^TObjectID readHexFrom: '1f2f349874e53ebe785f681585111111'! ! GridWorld removeSelector: #initializeAxes:! GridWorld removeSelector: #initializeCommonPortals:! GridWorld removeSelector: #initializeParcels! GridWorld removeSelector: #makeCubes:class:! GridParcelSpace removeSelector: #initialize!