KStandardHarness subclass: #GridHarness instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridHarness commentStamp: 'strick 3/21/2007 00:52' prior: 0! I do not seem to be specializing GridHarness yet ... but I have a hunch that some day I will.! KCroquetParticipant subclass: #GridParticipant instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridParticipant commentStamp: 'strick 3/21/2007 00:51' prior: 0! A Morph to instantiate to run the demo. Has a #descriptionForPartsBin. Sets the #entry to the GridWorld. Requests a GridHarness.! !GridParticipant methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2007 18:30'! createHarness ^ GridHarness new! ! !GridParticipant methodsFor: 'as yet unclassified' stamp: 'has 12/23/2006 20:14'! entry ^entry ifNil: [self entryWorld: GridWorld. entry]. ! ! !GridParticipant methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 17:33'! initialize "Add GridWorld if it is not already there" (self class worlds includes: GridWorld) ifFalse: [ self class worlds: self class worlds, { GridWorld } ]. "Add HolodeckSimpleDemoWorld if it is not already there" (self class worlds includes: HolodeckSimpleDemoWorld) ifFalse: [ self class worlds: self class worlds, { HolodeckSimpleDemoWorld } ]. super initialize ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GridParticipant class instanceVariableNames: ''! !GridParticipant class methodsFor: 'parts bin' stamp: 'strick 3/10/2007 18:31'! descriptionForPartsBin ^ self partName: 'Grid Demo' categories: #('Strick') documentation: 'not yet' sampleImageForm: self defaultForm.! ! TPortal3D subclass: #GridPortal3D instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridPortal3D commentStamp: '' prior: 0! We use GridPortal3D to render the 8 neighboring spaces. We do not want it to be blue or hazy, so we stifle the #renderAlpha: method.! !GridPortal3D methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2007 17:01'! renderAlpha: ogl "Do nothing. This overrides rendering Alpha on the cube."! ! TGroup subclass: #GridThings instanceVariableNames: 'space config gridSpace gridConfig' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridThings methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 14:57'! initializeInSpace: aSpace withConfig: aConfig | croquetRadius | gridSpace := aSpace. gridConfig := aConfig. croquetRadius := gridConfig parcelRadius * gridConfig gridScale. "in croq coor system" self localTransform: (self localTransform scalingX: gridConfig gridScale y: gridConfig gridScale z: gridConfig gridScale). self addRotationAroundX: 270. self translationX: croquetRadius negated y: 0 z: croquetRadius.! ! Object subclass: #GridThingsConfig instanceVariableNames: 'parcelRadius gridScale' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridThingsConfig methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 15:33'! parcelRadius: pr gridScale: gs " For now, assume this is initialized once, and then immutable. " parcelRadius := pr. gridScale := gs.! ! !GridThingsConfig methodsFor: 'accessing' stamp: 'strick 4/1/2007 15:33'! gridScale "Answer the value of gridScale" ^ gridScale! ! !GridThingsConfig methodsFor: 'accessing' stamp: 'strick 4/1/2007 15:33'! gridScale: anObject "Set the value of gridScale" gridScale := anObject! ! !GridThingsConfig methodsFor: 'accessing' stamp: 'strick 4/1/2007 15:33'! parcelRadius "Answer the value of parcelRadius" ^ parcelRadius! ! !GridThingsConfig methodsFor: 'accessing' stamp: 'strick 4/1/2007 15:33'! parcelRadius: anObject "Set the value of parcelRadius" parcelRadius := anObject! ! TSpace subclass: #GridThingsSpace instanceVariableNames: 'things gridConfig croquetRadius entryForCroquet' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridThingsSpace methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 16:05'! initializeThingsWithConfig: aGridConfig gridConfig := aGridConfig. croquetRadius := gridConfig parcelRadius * gridConfig gridScale. "in croq coor system" things := GridThings new initializeInSpace: self withConfig: gridConfig. self addChild: things. "We want to enter higher than the floor, which is at elevation 0. This specifies translation in old coordinates; it should use the new coords when I make that transform available... " entryForCroquet := TGroup new. entryForCroquet translation: 0@7@0. self addChild: entryForCroquet.! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! croquetRadius "Answer the value of croquetRadius" ^ croquetRadius! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! croquetRadius: anObject "Set the value of croquetRadius" croquetRadius := anObject! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! entryForCroquet "Answer the value of entryForCroquet" ^ entryForCroquet! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! entryForCroquet: anObject "Set the value of entryForCroquet" entryForCroquet := anObject! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! gridConfig "Answer the value of gridConfig" ^ gridConfig! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! gridConfig: anObject "Set the value of gridConfig" gridConfig := anObject! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! things "Answer the value of things" ^ things! ! !GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'! things: anObject "Set the value of things" things := anObject! ! GridThingsSpace subclass: #GridParcelSpace instanceVariableNames: 'master gridCoordinate' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridParcelSpace commentStamp: '' prior: 0! GridParcelSpace is the square unit of rendering. 9 of them are displayed (the one you are in, and 8 neighbors) when you are in a GridParcelSpace. It could also be the unit of island connection, but right now it is shared in island with GridWorld. master -- currently unused. points back to the GridWorld. gridConfig -- currently immutable. copied from GridWorld. things -- a TGroup with localTransformtion to convert from Grid To Croquet coordinates gridCoordinate -- the 2D integer coordinate of this parcel in the world croquetRadius -- cached radius of the parcel in Croquet, not Grid coordinates. We need to add two transform methods to convert between Croquet and Grid coordinates (or give the matrix). ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/14/2007 01:49'! gridCoordinate ^ gridCoordinate! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 15:25'! gridScale self error: 'I THINK THIS IS NOT USED'. ^ gridConfig gridScale ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 16:09'! initializeWithMaster: m atGridCoordinate: aPoint "initialize the superclass GridThingsSpace" self initializeThingsWithConfig: m gridConfig. " Some day master might be a FarRef? " master := m. gridCoordinate := aPoint. ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 16:01'! makeParcelEntryForFoyer "We want to enter higher than the floor, which is at elevation 0. This specifies translation in old coordinates; it should use the new coords when I make that transform available... " | frame | frame := TGroup new. frame translation: 0@7@0. self addChild: frame. ^ frame ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 01:17'! makeStuff | a b wheel | a := gridCoordinate x. b := gridCoordinate y. " stacks of magenta balls along x=y axis, in parcel 0,0 " a+b==0 ifTrue: [ 0 to: 8 do: [ :i | | q | q := i * 12.5. 0 to: i do: [ :j | self make: TSphere x: q y: q z: j radius: 0.4 color: Color magenta. ]]]. wheel := Color wheel: gridConfig xSize. 5 to: 96 by: 5 do: [ :j | self make: TSphere x: 7+(a*10) y: j z: 1 radius: 0.9 color: (wheel at: a+1) ]. wheel := Color wheel: gridConfig ySize. 5 to: 96 by: 5 do: [ :j | self make: TSphere x: j y: 7+(b*10) z: 0.5 radius: 0.3 color: (wheel at: b+1) ]. self make: TSphere x: (a\\4*25+12.5) y: (a+b\\4*25+12.5) z: (a+b) radius: 5 color: Color cyan. ! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2007 22:58'! make: aClass x: x y: y z: z radius: r color: colour | t | t := aClass new. t translationX: x y: y z: z. t colorize: colour. t class == TSphere ifTrue: [ t radius: r ] ifFalse: [ t extent: r@r@r ]. t radius: r. t objectName: aClass name, '_', x asString, '_', y asString. things addChild: t. ^ t.! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/14/2007 01:13'! master ^ master! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:56'! parcelRadius ^ gridConfig parcelRadius! ! !GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2007 00:53'! renderSpace: ogl | rval gtrans xform | gtrans := self globalTransform. rval := super renderSpace: ogl. false ifTrue: [ [ "self neighboringSpaces" #( ) do: [ :neighbor | | shift | shift := self parcelRadius * (neighbor gridCoordinate - self gridCoordinate). self globalTransform: ((gtrans + Matrix4x4 identity) translationX: shift x y: 0 z: shift y). "<< one way >> rval := rval + (neighbor renderSpace: ogl port: nil depth: 1 ghostFrame: nil). " "<< another way >> rval := rval + (neighbor renderSubspace: ogl). " "<< another way >> ogl pushMatrix. xform := Matrix4x4 identity translationX: shift x y: 1 z: shift y. ogl glMultTransposeMatrixf: xform. ogl popMatrix. " ]. ] ensure: [ self globalTransform: gtrans ]. ]. ^ rval! ! !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! ! WisconsinWorld subclass: #GridWorld instanceVariableNames: 'parcels gridPortals gridConfig' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridWorld commentStamp: '' prior: 0! GridWorld presents a "foyer" with portals to each of the GridParcelSpaces in the grid. GridWorld may not be necessary in the long run, or it may be useful to have a place for configuration information about the grid. ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:37'! createAxes: space space addChild: TFrame new. space addChild: (TFrame new translation: gridConfig parcelRadius @ gridConfig parcelRadius @ 0; yourself). ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 4/6/2007 22:32'! initialize | space sky flr | "CONFIGRUABLE CONSTANTS" gridConfig := GridWorldConfig new parcelRadius: 50 gridScale: 5; xSize: 5 ySize: 5; yourself. "space" gridPortals := Dictionary new. space := TSpace new. space registerGlobal: #mainEntry. "light" self makeLight: space. "floor -- must be local flr, not inst var floor, because Wisc wants to send #contents to floor" flr := self makeFloor: space fileName: 'lawn.bmp'. flr extentX: 100 y:0.5 z: 100. "sky" sky := TSkyBox new initializeWithFileName: 'GRS'. sky step. "get going" space addChild: sky. "toys" self createAxes: space. "parcels" self initializeParcels: space. self linkParcels. self initializeHolodeckSimpleDemoWorld: space. ^ space! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 15:52'! initializeParcels: space | wheel spoke portalPostcardFrame | parcels := Dictionary new. wheel := Color wheel: gridConfig xSize * gridConfig ySize. spoke := 1. 0 to: gridConfig xSize-1 do: [ :x | 0 to: gridConfig ySize-1 do: [ :y | | s p w | s := GridParcelSpace new initializeWithMaster: self atGridCoordinate: x@y. s objectName: 'GridParcelSpace_', x asString, '_', y asString. self makeRingOfCubesInNewCoords: s things color: (wheel at: spoke). self createAxes: s things. portalPostcardFrame := s makeParcelEntryForFoyer. s makeStuff. "like roads & houses & stuff" "-- make a portal in the Foyer World to enter each grid parcel --" w := self makePortal: 'lawn.bmp'. w objectName: 'Portal_into_', x asString, '_', y asString. p := w contents. p objectName: 'Postcard_into_', x asString, '_', y asString. "--old p postcardLink: s postcard. old--" p postcardLink: portalPostcardFrame 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' radius: gridConfig parcelRadius * gridConfig gridScale. self makeLight: s. parcels at: x@y put: s. spoke := spoke+1. ] ] ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:40'! linkParcels | toCoord tg diam | 0 to: gridConfig xSize-1 do: [ :x | 0 to: gridConfig ySize-1 do: [ :y | | from to p | from := parcels at: x@y. self makeRedBlueLandmarksIn: from x: x y: y. "-- now the actual edge portals --" diam := gridConfig gridScale * 2 * gridConfig parcelRadius. 1 negated to: 1 do: [ :i | 1 negated to: 1 do: [ :j | (i~=0 or: [j~=0]) ifTrue: [ toCoord := (x+i+gridConfig xSize\\gridConfig xSize) @ (y+j+gridConfig ySize\\gridConfig ySize). to := parcels at: toCoord. p := GridPortal3D new. p extent: diam@diam. "strangely, TPortal3D>>extent: actually only uses the x value" p scale: 1.0 . "default was to shrink -- we dont want that" p postcardLink: to. tg := TGroup new. tg translation: (i*diam) @ 0 @ (j*diam)negated. "in croquet coords, not Grid's" tg addChild: p. from addChild: tg. ]]]. ]] ! ! !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 3/11/2007 17:03'! makePortal: aTextureName from: gridCoordinateFrom to: gridCoordinateTo | p | p := self makePortal: aTextureName. gridPortals at: {gridCoordinateFrom. gridCoordinateTo.} put: p. ^p. ! ! !GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:33'! makeRingOfCubesInNewCoords: sp color: aColor | r | r := gridConfig parcelRadius. 0 to: r*2 by: (r/4) do: [ :i | | c | c := TCube new colorize: aColor. c translation: 0 @ i @ 0. sp addChild: c. c := TCube new colorize: aColor. c translation: r*2 @ i @ 0. sp addChild: c. c := TCube new colorize: aColor. c translation: i @ 0 @ 0. sp addChild: c. c := TCube new colorize: aColor. c translation: i @ r*2 @ 0. sp addChild: c. ]! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:24'! gridConfig ^ gridConfig! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:24'! gridScale ^ gridConfig gridScale! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 4/1/2007 17:40'! initializeCommonPortals: space | portal x | "--- TODO(strick) Move this to grid coordinates ---" x := 20. { WisconsinWorld. GridWorld. HolodeckSimpleDemoWorld. } do: [ :worldClass | self makeOnePortal: worldClass textureFileName: 'logo.png' scale: 2 position: x@5@-20 space: space. "-- TODO -- request that above method return the new portal --" portal := space frameChildren last. "-- assuming it is the last --" portal objectName: 'Portal_to_', worldClass name. x := x + 20. ]. ! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 4/7/2007 01:53'! initializeHolodeckSimpleDemoWorld: space | s w p | s := HolodeckSimpleSpace new. w := self makePortal: 'checker.bmp'. p := w contents. "--old p postcardLink: s postcard. old--" p postcardLink: s postcard. w extent: 5@5. w translation: (0-20) @ 0 @ (0-20). space addChild: w. self makeLight: s. self makeFloor: s fileName: 'lawn.bmp' radius: 100. s initializeThingsWithConfig: ( GridWorldConfig new parcelRadius: 50 gridScale: 5; yourself). self makeRingOfCubesInNewCoords: s things color: Color green. ! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/18/2007 14:31'! makeFloor: sp fileName: txtrName radius: parcelRadius | stone txt mat | txt := TTexture new initializeWithFileName: txtrName mipmap: true shrinkFit: false. txt uvScale: 8.0@8.0. mat := TMaterial new. mat objectName: 'floorMaterial' copy. mat texture: txt. stone := TCube new. "-- Place the floor with top edge one centimeter below 0. --" stone extentX:parcelRadius*2 y:1.0 z: parcelRadius*2. stone translationX: 0 y: -0.51 z: 0.0. "<<< Older croquet standard: stone extentX:parcelRadius*2 y:0.5 z: parcelRadius*2. stone translationX: 0 y: -6.0 z: 0.0. >>>" " stone texture: txt." stone material: mat. stone objectName: 'floor' copy. sp addChild: stone. ^ stone. ! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:26'! makeRedBlueLandmarksIn: space x: x y: 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. space 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. space addChild: b. ]. ! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:25'! parcelRadius ^ gridConfig parcelRadius! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/14/2007 01:39'! parcels ^ parcels! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:24'! xSize ^ gridConfig xSize! ! !GridWorld methodsFor: 'initialize' stamp: 'strick 3/21/2007 00:24'! ySize ^ gridConfig ySize! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GridWorld class instanceVariableNames: ''! !GridWorld class methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:22'! islandID ^TObjectID readHexFrom: '1f2f349874e53ebe785f681585111111'! ! GridThingsConfig subclass: #GridWorldConfig instanceVariableNames: 'xSize ySize' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'! !GridWorldConfig commentStamp: 'strick 3/21/2007 00:22' prior: 0! GridConfig is a small object with basic parameters about the size & shape of the GridWorld. It seems the GridWorld should be initalized with an immutable copy of GridConfig. Each GridParcelSpace can then have a copy in-island (when they become islands). It would make since to modify a GridConfig, particularly to increase xSize or ySize; but we won't think about that yet. xSize: number of parcels across in X direction, or East. ySize: number of parcels wide in Y direction, or North. parcelRadius: half the width of a parcel, in X and in Y direction (it must be square). gridScale: render everything this much bigger. Adjust to make 1 unit feel like 1 meter. ! !GridWorldConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'! xSize ^ xSize! ! !GridWorldConfig methodsFor: 'as yet unclassified' stamp: 'strick 4/1/2007 15:34'! xSize: xs ySize: ys " For now, assume this is initialized once, and then immutable. " xSize := xs. ySize := ys.! ! !GridWorldConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'! xSize: xs ySize: ys parcelRadius: pr gridScale: gs " For now, assume this is initialized once, and then immutable. " xSize := xs. ySize := ys. parcelRadius := pr. gridScale := gs.! ! !GridWorldConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'! ySize ^ ySize! ! GridWorld subclass: #GridWorldDemo5x5 instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Grid-Croquet'!