Object subclass: #GridConfig
	instanceVariableNames: 'xSize ySize parcelRadius gridScale'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridConfig 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.

!


!GridConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:19'!
gridScale

	^ gridScale! !

!GridConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'!
parcelRadius

	^ parcelRadius! !

!GridConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'!
xSize

	^ xSize! !

!GridConfig 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.! !

!GridConfig methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:18'!
ySize

	^ ySize! !


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.!



TSpace subclass: #GridParcelSpace
	instanceVariableNames: 'master gridConfig things gridCoordinate croquetRadius'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridParcelSpace commentStamp: '<historical>' 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 3/21/2007 00:58'!
gridScale

	^ gridConfig gridScale
! !

!GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 01:29'!
initializeWithMaster: m atGridCoordinate: aPoint

	" Some day master might be a FarRef? "

	master := m.
	gridConfig := m gridConfig.
	gridCoordinate := aPoint.

	croquetRadius := gridConfig parcelRadius * gridConfig gridScale. "in croq coor system"

	"For things, Z is up.   The following rotation maps things to Croquet's system, where Y is up."
	things := TGroup new.
	things localTransform: (things localTransform scalingX: gridConfig gridScale y: gridConfig gridScale z: gridConfig gridScale).
	things addRotationAroundX: 270.
	things translationX: croquetRadius negated y: 0 z: croquetRadius.
	self addChild: things.

	"==== The following is unused, now that we use 3D portals ==="
	"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: croquetRadius y: 0 z: 0.
	inWest translationX: croquetRadius negated y: 0 z: 0.
	inNorth translationX: 0 y: 0 z: croquetRadius negated.
	inSouth translationX: 0 y: 0 z: croquetRadius.

	self addChild: inWest.
	self addChild: inNorth.
	self addChild: inEast.
	self addChild: inSouth.

	Transcript cr; print: (self asString,  ' <===initWithMaster: ', m asString, ' atGP: ', Point asString ).
>>>>>>>>>>"! !

!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! !


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: 'has 12/23/2006 20:41'!
initialize

	"Add GridWorld if it is not already there"

	(self class worlds includes: GridWorld) ifFalse: [

		self class worlds: self class worlds, { GridWorld }

	].

	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: '<historical>' 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."! !


WisconsinWorld subclass: #GridWorld
	instanceVariableNames: 'parcels gridPortals gridConfig'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridWorld commentStamp: '<historical>' 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 3/21/2007 00:28'!
initialize
	| space sky flr |

"CONFIGRUABLE CONSTANTS"
	gridConfig := GridConfig new xSize: 5 ySize: 5 parcelRadius: 50 gridScale: 5.

"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.

	^ space! !

!GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 3/21/2007 00:41'!
initializeParcels: space

	| wheel spoke |

	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 := nil.
			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.

			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.
			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' 
				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 3/19/2007 23:16'!
initializeCommonPortals: space

	| portal x |

	"--- TODO(strick) Move this to grid coordinates ---"

	x := 20.

	{ WisconsinWorld. GridWorld. } 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 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'! !