'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 23 December 2006 at 8:49:44 pm'!
KStandardHarness subclass: #GridHarness
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Strick-Grid2'!
TSpace subclass: #GridParcelSpace
	instanceVariableNames: 'xloc yloc things inWest inNorth inEast inSouth radius'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Strick-Grid2'!
WisconsinWorld subclass: #GridWorld
	instanceVariableNames: 'xSize ySize parcels parcelRadius gridScale'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Strick-Grid2'!
KCroquetParticipant subclass: #GridParticipant
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Strick-Grid2'!

!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: 'has 12/23/2006 20:10'!
initializeWithRadius: r

	radius := r.

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


!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: 'has 12/23/2006 20:47'!
initialize
	| space sky flr |

"CONFIGRUABLE CONSTANTS"
	parcelRadius := 50. "half the length of a parcel edge"
	gridScale := 2. "doubles the apparent size of the spaces"
1 say.
"space"
	space := TSpace new.
	space registerGlobal: #mainEntry.
2 say.
"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.
3 say.
"sky"
	sky := TSkyBox new initializeWithFileName: 'GRS'.
	sky step. "get going"
	space addChild: sky.
4 say.
"toys"
	self createAxes: space.

5 say.
"parcels"
	self initializeParcels: space.
6 say.
	self linkParcels.
7 say.

	^ space! !

!GridWorld methodsFor: 'as yet unclassified' stamp: 'has 12/23/2006 20:43'!
initializeParcels: space

	xSize := 3.
	ySize := 3.
	parcels := Dictionary new.

	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.
(x@y) say: 'did axes'.
			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.

(x@y) say: 'did portal'.
			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. 

(x@y) say: 'did all'.
		].
	].
 ! !

!GridWorld methodsFor: 'as yet unclassified' stamp: 'has 12/23/2006 20:32'!
linkParcels


	0 to: xSize-1 do: [ :x |
	 	0 to: ySize-1 do: [ :y |
			| from to w p |
			from := parcels at: x@y.

(x@y) say: 'linking...'.
			"-- 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/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: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 class methodsFor: 'as yet unclassified' stamp: 'strick 12/13/2006 01:22'!
islandID
	^TObjectID readHexFrom: '1f2f349874e53ebe785f681585111111'! !


!KCroquetParticipant methodsFor: 'initialization' stamp: 'has 12/23/2006 20:16'!
createStandardHarness

	^ 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 removeSelector: #initialize!