Object subclass: #Grid
	instanceVariableNames: ''
	classVariableNames: 'CriticalMutexObject WebMutexObject'
	poolDictionaries: ''
	category: 'Grid-Croquet'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Grid class
	instanceVariableNames: ''!

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:57'!
ask: aSelector ofRef: aRef

	"-- callers beware:  returns NIL if it cannot resolve --"
	aRef isResolved ifFalse: [ ^nil. ].

	^ aRef syncSend: aSelector withArguments: #()! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:15'!
critical: aBlock

	CriticalMutexObject ifNil: [ CriticalMutexObject := TMutex new ].

	CriticalMutexObject critical: aBlock.
! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:16'!
notenb: something

	CriticalMutexObject ifNil: [ CriticalMutexObject := TMutex new ].

	CriticalMutexObject critical: [
		Transcript
			nextPutAll: something asString;
			flush.
	].
! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:16'!
noten: something
false ifTrue: [
	CriticalMutexObject ifNil: [ CriticalMutexObject := TMutex new ].

	CriticalMutexObject critical: [
		Transcript
			nextPutAll: something asString;
			flush.
	].
]! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:16'!
note: something

	CriticalMutexObject ifNil: [ CriticalMutexObject := TMutex new ].

	CriticalMutexObject critical: [
		Transcript
			cr;
			nextPutAll: something asString;
			flush.
	].
		! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:19'!
ref: aRef isKindOf: aClass

	aRef isResolved ifFalse: [ ^false. ].

	^ aRef syncSend: #isKindOf withArguments: { aClass }.
! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:09'!
secondsNow
	"--Since the Squeak Epoch; see Date>>asSeconds --
	-- WARNING bigger than signed int32 --
	self secondsNow
	"

	| now |
	now := Time dateAndTimeNow.
	^ now first asSeconds + now second asSeconds


! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:17'!
webMutex: aBlock

	WebMutexObject ifNil: [ WebMutexObject := TMutex new ].

	WebMutexObject critical: aBlock.
! !


KAvatarUser subclass: #GridAvatarUser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridAvatarUser commentStamp: '<historical>' prior: 0!
GridAvaterUser specializes #sendMessage:how: so that it gets sent to the Grid Network.

to use this, GridHarness>>initializeAvatar: 
must be overriden to create the correct kind of avatar.

TODO -- Perhaps "Things" or GridThingsSpace or GridWorld (or some other message relay model object on island) can serve this role.
But it would have to find both the chat window and the network, and that might be messy.
Or maybe subclass CChatWindow to do it?  But with the message sending model, this is not
supposed to be hard to do.   I should figure it out.  --strick
!


!GridAvatarUser methodsFor: 'as yet unclassified' stamp: 'strick 7/30/2007 07:40'!
openWindow

	"define an extra script, to send chat messages typed here out the the grid"

	super openWindow.

	self startScript: #sendMessageToGrid:how: when: {chatWindow. #sendChatItem}.! !

!GridAvatarUser methodsFor: 'as yet unclassified' stamp: 'strick 8/19/2007 17:42'!
sendMessageToGrid: msg how: how

	| m mc hect harn |
	harn := self harness.
	m := '[', harn userName asString, ': ', how asString, ': [', msg asString, ']]'.

	Transcript cr; 
		nextPutAll: '[SendMessageToGrid: ', harn userName asString, ': ', how asString, ': ', m, '] ';
		endEntry.

	self flag: #strick. "Create unique IDs"

	mc := harn mc.
	mc ifNotNil: [
		hect := Grid ask: #objectName ofRef: harn activeSpace.
		mc ifNotNil: [ | r |
			r := (1000000000 + (harn randInt: 999999999)) asString.
			harn mc push:
				'&h=', hect, '&id=',r,'&key=C&value=', m encodeForHTTP. ].
	].! !


TFrame subclass: #GridBoundary
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridBoundary methodsFor: 'as yet unclassified' stamp: 'strick 7/11/2007 22:26'!
renderBoundary: ogl

	ogl glDisable: GLLighting;

		glColor3fv: #(0.0 0.0 0.0) asFloatArray;
		glBegin: GLLineStrip;   
			glVertex3fv:#(-50.0 50.0 0.0)asFloatArray;
			glVertex3fv:#(-50.0 -50.0 0.0)asFloatArray;
			glVertex3fv:#(50.0 -50.0 0.0)asFloatArray;
"
			glVertex3fv:#(-49.0 -49.0 0.0)asFloatArray;
			glVertex3fv:#(49.0 -49.0 0.0)asFloatArray;
			glVertex3fv:#(49.0 49.0 0.0)asFloatArray;
			glVertex3fv:#(-49.0 49.0 0.0)asFloatArray;
			glVertex3fv:#(-49.0 -49.0 0.0)asFloatArray;
"
		glEnd;
    
"<<
		glColor3fv: #(0.0 1.0 0)asFloatArray;
		glBegin: GLLineStrip;
    
			glVertex3fv:#(0.0 -1.0 0.0)asFloatArray;
    
			glVertex3fv:#(0.0 1.0 0.0)asFloatArray;
    
		glEnd;
>>"
	glEnable: GLLighting.! !

!GridBoundary methodsFor: 'as yet unclassified' stamp: 'strick 7/11/2007 00:26'!
render: ogl

	self renderBoundary: ogl.! !


TContactPoint subclass: #GridContactPoint
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridContactPoint methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 23:52'!
initialize

	DefaultPort := 50000 + ( Grid secondsNow \\ 9999 ).
		! !


Object subclass: #GridDelay
	instanceVariableNames: 'queue sleepUntil'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridDelay methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:22'!
gridHarness: aGridHarness

	aGridHarness sendTicksTo: self.! !

!GridDelay methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:30'!
initialize

	sleepUntil := 0.  "means nothing is sleeping"
	queue := SharedQueue new.
	^ super initialize.

! !

!GridDelay methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:11'!
sleepFor: someSeconds

	sleepUntil := someSeconds + Grid secondsNow.

	"Grid note: 'SLEEP UNTIL ', sleepUntil asString."

	^ queue next! !

!GridDelay methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:10'!
tick

	"This might contain critical races in some circumstances,
	but Delay is definately broken,
	and this should do for my purposes in Grid."

	| now | 

	now := Grid secondsNow.

	"-- skip if no one is sleeping --"
	( sleepUntil = 0 ) ifTrue: [ ^self ].

	"-- wake the sleeper if time has expired --"
	( now >= sleepUntil ) ifTrue: [
		"Grid note: 'tick->WAKE ', now asString."

		Grid critical: [
			queue nextPut: now.
			sleepUntil := 0.  "clear it so no more nextPuts."
		].
	] ifFalse: [
		"Grid note: 'tick->NOTYET ', now asString."
	].

	"
GridDelay new gridHarness: H; sleepFor: 0
	"! !


KStandardHarness subclass: #GridHarness
	instanceVariableNames: 'rand spacesRendered workQueue spacesQueueToBeStarted spacesSetToBeStarted gridInfoMorph ticksSubscribers mcDict'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridHarness commentStamp: '<historical>' prior: 0!
I do not seem to be specializing GridHarness yet ... but I have a hunch that some day I will.
Now I am.!


!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 22:36'!
avatarPositionInGrid

	| as g x y z ar inverse |
	as := self activeSpace.
	ar := self avatar replica.
	
	ar ifNil: [ ^ nil. ].
	
	(Grid ask: #class ofRef: as) == GridParcelSpace ifFalse: [ ^ nil ].

	inverse := (Grid ask: #thingsInverse ofRef: as).
	inverse ifNil: [ ^ nil ].

	g := Grid ask: #globalTransform ofRef: ar.
	g ifNil: [ ^ nil ].
	g := inverse * g.
	x := g a14.
	y := g a24.
	z := g a34.

	^ x @ y @ z! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:55'!
delayForSeconds: s

	| d |
	d := GridDelay new.
	d gridHarness: self.
	d sleepFor: s.

	"This is messy and should be handled better: "
	Grid critical: [ ticksSubscribers remove: d. ].
! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/15/2007 21:43'!
doSomeWork

	| aJob |

	[
		aJob := workQueue nextOrNil.
		aJob notNil
	] whileTrue: [
		Grid noten: '-'.
		aJob perform.
	].
		! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/13/2007 01:02'!
enqueueSomeWork: aJob

	workQueue nextPut: aJob. 
	Grid noten: '+'.! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 21:59'!
gridInfo

	| as g s x y z ar inverse |
	as := self activeSpace.
	ar := self avatar replica.
	
	(Grid ask: #class ofRef: as) == GridParcelSpace ifTrue: [

		s := (Grid ask: #gridCoordinate ofRef: as) asString.
		inverse := (Grid ask: #thingsInverse ofRef: as).
		
	] ifFalse: [
		s := (Grid ask: #asString ofRef: as) asString.  "Note: #ask:ofRef: may return nil "
		inverse := nil.
	].

	ar ifNotNil: [
		g := Grid ask: #globalTransform ofRef: ar.
		inverse ifNotNil: [ g := inverse * g. ].
		x := g a14 asInteger asString.
		y := g a24 asInteger asString.
		z := g a34 asInteger asString.
		^ ' at (',x,',',y,',',z,') in ',s
	] ifNil: [
		^ 'nilAvatarReplica in ', s
	].
! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/14/2007 19:00'!
gridInfoMorph

	( (overlays size > 0) and: [overlays first class == GridParticipant] )
	ifTrue: [
		^ overlays first gridInfoMorph
	] ifFalse: [
		^ nil
	]
	! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/14/2007 18:42'!
gridInfoMorph: m

	gridInfoMorph := m.! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:14'!
initialize

	contactPoint = GridContactPoint new.
	rand := Random new.
	ticksSubscribers := Set new.
	mcDict := Dictionary new.
	
	spacesRendered := Set new.
	workQueue := SharedQueue new.
	spacesQueueToBeStarted := SharedQueue new.
	spacesSetToBeStarted := Set new.

	super initialize.

	H := self.  "debugging hack -- remember the harness in global var"! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/30/2007 07:32'!
initializeAvatar: mySnapshots
	"DUPLICATED from KStandardHarness, so we can change what kind of KAvatarUser to create"

	"NOTE: we don't really need 'mySnapshots' as an argument, since we can just refer to the 'snapshots' iVar."
	"<<avatar := KAvatarUser new.>>"
	avatar := GridAvatarUser new.
	avatar userID: userID.
	avatar harness: self.
	avatar snapshots: mySnapshots.
	avatar loadAvatar: 'Content/Avatars/WhiteRabbit.mdl'.
! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:22'!
mc
	^ mcDict at: self activeSpace ifAbsent: [nil]

		! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:44'!
randInt: max

	^ rand nextInt: max! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/1/2007 17:22'!
randPt

	^ rand next @ rand next @ rand next! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:26'!
renderWorld

	| s gim |

	self sendATickToEachSubscriber.  "We take advantage of renderWorld to send ticks"

	s := spacesQueueToBeStarted nextOrNil.
	s ifNotNil: [ "start just one space each time"
		self startMatterCompilerOnSpaceRef: s.
	].

	"now we can do some work if it has been queued jup"

	self doSomeWork.

	gim := self gridInfoMorph.
	gim ifNotNil: [
		gim moreContents: self gridInfo.
	]. 

	^ super renderWorld! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:25'!
sendATickToEachSubscriber

	ticksSubscribers asArray do: [ :sub  |  sub tick ].! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 20:21'!
sendTicksTo: aGridDelay

	Grid critical: [ ticksSubscribers add: aGridDelay ].

	! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 23:25'!
spacesRendered

	^ spacesRendered! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/13/2007 22:04'!
startIfNecessary: aSpace

	"add to queue and set, unless it is already in set"

| aSpaceRef |
(aSpace class inheritsFrom: GridThingsSpace) ifTrue: [

	aSpaceRef := Processor activeIsland asFarRef: aSpace.

	(spacesSetToBeStarted includes: aSpaceRef) ifFalse: [

		spacesQueueToBeStarted nextPut: aSpaceRef.
		spacesSetToBeStarted add: aSpaceRef.

	].
].
! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:26'!
startMatterCompilerOnSpaceRef: aSpaceRef


	| name mc |
	mc := MatterCompiler new.
	mc spaceRef: aSpaceRef.
	mc harness: self.

	name := aSpaceRef syncSend: #objectName withArguments: #().
	mc hectare: name.

	Grid notenb: ' (*', name, '*) '.

	mc startEventLoop.
	mcDict at: aSpaceRef put: mc.
! !


FrameRateMorph subclass: #GridInfoMorph
	instanceVariableNames: 'moreContents'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!GridInfoMorph commentStamp: '<historical>' prior: 0!
GridInfoMorph subclasses FrameRateMorph to display more information
in the top righthand corner (which GridHarness turns on by default).

A more efficient implementation would ask for moreContents to be
calculated on demand, by the Morph.  
But this version caclulates it on every renderWorld, by the harness.!


!GridInfoMorph methodsFor: 'accessing' stamp: 'strick 7/14/2007 18:26'!
contents: s

	super contents: (s asString, ' ', moreContents).	! !

!GridInfoMorph methodsFor: 'accessing' stamp: 'strick 7/14/2007 18:25'!
moreContents
	"Answer the value of moreContents"

	^ moreContents! !

!GridInfoMorph methodsFor: 'accessing' stamp: 'strick 7/14/2007 18:25'!
moreContents: anObject
	"Set the value of moreContents"

	moreContents := anObject! !


KMenuBar subclass: #GridMenuBar
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridMenuBar methodsFor: 'as yet unclassified' stamp: 'strick 7/10/2007 02:24'!
harness

	^ hand world ownerMorph harness
! !

!GridMenuBar methodsFor: 'as yet unclassified' stamp: 'strick 8/1/2007 15:27'!
menuBarGridMenu

	| menu |

	menu := CMenu new.
	menu add: 'Debug' target: self action: #debug.
	menu add: 'Explore Menu Bar' target: self action: #explore.
	menu add: 'Explore Harness' target: self harness action: #explore.
	"--menu add: 'Explore Space' target: self harness activeSpace action: #explore.--"
	"--menu add: 'Connect To Grid' target: self action: #actionConnectToGrid.--"
	menu add: 'Zork' target: self action: #zork.
	^ menu! !

!GridMenuBar methodsFor: 'as yet unclassified' stamp: 'strick 7/10/2007 02:17'!
newWorldMenu

	| menu |
	menu := super newWorldMenu.

	menu add: 'Grid' subMenu: self menuBarGridMenu.
	^ menu! !


KMenuWorld subclass: #GridMenuWorld
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridMenuWorld methodsFor: 'as yet unclassified' stamp: 'strick 7/10/2007 02:11'!
onBootstrap
	"Load auto load targets"
	| project |
	self flag: #FIXME. "We shouldn't have to repeat all this code just to customize the menu."
	self startScript: #onDrop: when: {self. #dragDrop}.
	project := Smalltalk at: #GridMenuBar ifPresent:[:cls| cls new].
	project window: self.
	project topLeft: 0@0.
	project costume isWorld: true.
	self add: project.
	self activeProject: project.! !


KCroquetParticipant subclass: #GridParticipant
	instanceVariableNames: 'gridInfoMorph'
	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: 'strick 6/30/2007 14:56'!
demoWorlds

	^ { GridWorld. }! !

!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 7/14/2007 18:37'!
gridInfoMorph

	^ gridInfoMorph! !

!GridParticipant methodsFor: 'as yet unclassified' stamp: 'strick 7/22/2007 23:33'!
initialize

	self class defaultRouterPort: 50000 + (
		Grid secondsNow \\ 9999 ).

	"Add each demoWorld if it is not already there"

	(self demoWorlds) do: [ :w |
		(self class worlds includes: w) ifFalse: [

			self class worlds: self class worlds, { w }

		]
	].

	super initialize.
	gridInfoMorph := GridInfoMorph new.

	self toggleFrameRate.

! !

!GridParticipant methodsFor: 'as yet unclassified' stamp: 'strick 7/10/2007 02:32'!
initializeTweakWorld
	self initializeTweakWorld: #GridMenuWorld.! !


!GridParticipant methodsFor: 'accessing' stamp: 'strick 7/14/2007 18:35'!
toggleFrameRate
	self fpsMorph: (self fpsMorph ifNil:[ gridInfoMorph ] ifNotNil:[nil])
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GridParticipant class
	instanceVariableNames: ''!

!GridParticipant class methodsFor: 'parts bin' stamp: 'strick 7/12/2007 19:09'!
defaultRouterAddress

	" THIS METHOD prevents the client from asking for the 'interactivity server' address.
	  Just delete this method to restore asking.
	"

	^ RouterAddress ifNil: [
		KMessageRouter dispatcher
			ifNotNil: [NetNameResolver localAddressString]
			ifNil: [
				Grid noten: ' [runRouters] '.
				KMessageRouter runRouters
			]
	]! !

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


TGroup subclass: #GridThing
	instanceVariableNames: 'gtShape gtPos gtSize gtRot gtColor gtTexture'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridThing methodsFor: 'accessing' stamp: 'strick 7/12/2007 20:28'!
boundSphere

"having problems with culling?   so try making radius big"

   ^ TBoundSphere localPosition: gtPos radius: 30
"
	^ super boundSphere
"! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 12:50'!
gtColor
	"Answer the value of gtColor"

	^ gtColor! !

!GridThing methodsFor: 'accessing' stamp: 'strick 7/1/2007 17:53'!
gtColor: aColor
	"Set the value of gtColor"

	gtColor := aColor.

	self colorize: aColor! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 12:50'!
gtPos
	"Answer the value of gtPos"

	^ gtPos! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 13:50'!
gtPos: anObject
	"Set the value of gtPos"

	gtPos := anObject.
	self gtUpdatePosSizeRot.! !

!GridThing methodsFor: 'accessing' stamp: 'strick 7/1/2007 17:04'!
gtPos: p size: s rot: r

  gtPos := p.
  gtSize := s.
  gtRot := r.

  self gtUpdatePosSizeRot.! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 12:50'!
gtRot
	"Answer the value of gtRot"

	^ gtRot! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 13:50'!
gtRot: anObject
	"Set the value of gtRot"

	gtRot := anObject.
	self gtUpdatePosSizeRot.! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 12:52'!
gtShape
	"Answer the value of gtShape"

	^ gtShape! !

!GridThing methodsFor: 'accessing' stamp: 'strick 7/16/2007 01:21'!
gtShape: s

	| guts |
	self removeAll.

	s == #cube ifTrue: [
	  guts := TCube newOn: self island. "faster than new"
	].
	s == #sphere ifTrue: [
	  guts := TSphere newOn: self island. "faster than new"
	].
	s == #cylinder ifTrue: [
	  guts := TCylinder newOn: self island. "faster than new"
	  guts baseRadius: 0.5.
	  guts topRadius: 0.5.
	  guts height: 1.0.
	  guts rotationAroundX: 90.
	  guts translationX: 0.0 y: 0.0 z: -0.5.
	].

	guts ifNil: [
		self error: ('Unknown gtShape: ',s asString)
	] ifNotNil: [
		guts colorize: gtColor.
		self addChild: guts.
		gtShape := s.
	].

! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 12:50'!
gtSize
	"Answer the value of gtSize"

	^ gtSize! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 13:50'!
gtSize: anObject
	"Set the value of gtSize"

	gtSize := anObject.
	self gtUpdatePosSizeRot.! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 13:32'!
gtTexture
	"Answer the value of gtTexture"

	^ gtTexture! !

!GridThing methodsFor: 'accessing' stamp: 'strick 6/30/2007 13:32'!
gtTexture: anObject
	"Set the value of gtTexture"

	gtTexture := anObject! !

!GridThing methodsFor: 'accessing' stamp: 'strick 7/14/2007 01:04'!
gtUpdatePosSizeRot

  | tm sm  im jm km  m |
  tm := Matrix4x4 identity  translation: gtPos.
  sm := Matrix4x4 identity scaling: gtSize.
  im := Matrix4x4 identity rotationAroundX: gtRot x.
  jm := Matrix4x4 identity rotationAroundY: gtRot y.
  km := Matrix4x4 identity rotationAroundZ: gtRot z.

  m := tm * km * jm * im * sm.

  self localTransform: m.
! !

!GridThing methodsFor: 'accessing' stamp: 'strick 7/14/2007 16:57'!
initialize

	super initialize.
	solid := true.

	gtPos := 50@50@0.
	gtSize := 1@1@1.
	gtRot := 0@0@0.
	gtColor := Color brown.

"-- let's expect location and shape to follow soon after
	self gtUpdatePosSizeRot.
	self gtShape: #cube.
--"
! !


TGroup subclass: #GridThings
	instanceVariableNames: 'space config gridSpace gridConfig inverse'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridThings methodsFor: 'as yet unclassified' stamp: 'strick 7/16/2007 00:42'!
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.

	inverse := self localTransform inverseTransformation
! !

!GridThings methodsFor: 'as yet unclassified' stamp: 'strick 7/16/2007 00:43'!
inverse

	^ inverse! !


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 7/22/2007 21:45'!
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 7/2/2007 00:05'!
makeName: name shape: shape

	| t |
	t := GridThing new.
	t objectName: name.
	t gtShape: shape.
	things addChild: t.
	^ t

	 ! !

!GridThingsSpace methodsFor: 'accessing' stamp: 'strick 7/13/2007 21:54'!
renderSpace: ogl port: portal depth: depth ghostFrame: ghost


	"Remember (in the harness) that the space (that this portal points to) has been rendered"
	ogl harness startIfNecessary: self.

	^ super renderSpace: ogl port: portal depth: depth ghostFrame: ghost! !

!GridThingsSpace methodsFor: 'accessing' stamp: 'strick 7/13/2007 23:07'!
renderSubspace: ogl

	
	"Remember (in the harness) that the space (that this portal points to) has been rendered"

	ogl harness startIfNecessary: self.

	^ super renderSubspace: ogl.
! !

!GridThingsSpace methodsFor: 'accessing' stamp: 'strick 4/7/2007 01:48'!
things
	"Answer the value of things"

	^ things! !

!GridThingsSpace methodsFor: 'accessing' stamp: 'strick 7/16/2007 00:48'!
thingsInverse

	^ things inverse! !

!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: '<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 4/1/2007 15:25'!
gridScale

	self error: 'I THINK THIS IS NOT USED'.

	^ gridConfig gridScale
! !

!GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 7/14/2007 19:02'!
initializeWithMaster: m atGridCoordinate: aPoint

	
	Grid notenb: ' [Parcel ', aPoint asString, '] '.

	"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 7/22/2007 21:43'!
makeStuff

	"--we used to make a bunch of junk here, but now just the Black Lines
	   markin the edge of the parcel.
	--"

	"Raise the boundary 0.1m, so it's visible over the floor."
	things addChild: (GridBoundary new translation: 50@50@0.1; yourself).
! !

!GridParcelSpace methodsFor: 'as yet unclassified' stamp: 'strick 7/1/2007 17:41'!
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 objectName: aClass name, '_', x asString, '_', y asString.
	things addChild: t.
	t solid: true.
	^ 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 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: '<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 7/31/2007 14:27'!
initialize
	| space flr |

"CONFIGRUABLE CONSTANTS"

	gridConfig := GridWorldConfig new
		parcelRadius: 50 gridScale: 5; 
		xSize: self demoSize x ySize: self demoSize y;
		yourself.

"space"
	gridPortals := Dictionary new.
	space := GridWorldEntrySpace new.
	space objectName: ('Space_', self class name).
	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.
	space addChild: sky.
>>"

"toys"
	"self createAxes: space."

"parcels"
	self initializeParcels: space.
	space parcels: parcels.

	"self linkParcels."
	
	Grid notenb: ' <actPri=', Processor activePriority asString, '> '.
	Grid notenb: ' *linkParcels FORKING * '.
	self fork: #linkParcels at: Processor activePriority - 1.
	Grid notenb: ' *linkParcels FORKED* '.

"------------	self initializeHolodeckSimpleDemoWorld: space."

	^ space! !

!GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 7/29/2007 06:39'!
initializeParcels: space

	| spoke portalPostcardFrame p3 tg diam |

	parcels := Dictionary new.
	spoke := 1.
	diam := gridConfig gridScale * 2 * gridConfig parcelRadius.

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

"---3d" false ifTrue: [
			p3 := GridPortal3D new.
			p3 objectName: '3dPortal_', x asString, '_', y asString.
			"im not sure what combination of extent and scale to use"
			p3 extent: 100@100.
			p3 scale: 0.01.
			p3 postcardLink: s. "to"

			tg := TGroup new.
			tg objectName: '3dGroup_', x asString, '_', y asString.
			tg translation: (10*x-17)negated @ 0 @ (10*y+10). "in croquet coords, not Grid's"
			tg addChild: p3.
			"from" space addChild: tg.
]. "3d---"

			"<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 7/14/2007 19:02'!
linkParcels

	| toCoord tg diam |
	0 to: gridConfig xSize-1 do: [ :x |
	 	0 to: gridConfig ySize-1 do: [ :y |
			| from to  p |
			Grid notenb: '[Link ', x asString, '@', y asString, '] '.
			from := parcels at: x@y.

			self makeRedGreenLandmarksIn: 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/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 6/30/2007 14:52'!
demoSize

	"answer minimum size (3x3) for fastest testing"

	^ 3 @ 3 ! !

!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 7/4/2007 12:33'!
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: 3 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 7/2/2007 23:32'!
makeRedGreenLandmarksIn: space x: x y: y

			"-- make landmarks in parcel --"
			0 to: x do: [ :i | | b |   "red for x"
				b := TCube new.
				i>0 ifTrue: [b colorize: Color red].
				b translation: -5 @ (1+i*1.5) @ -15.
				space addChild: b.
			].
			0 to: y do: [ :i | | b |  "green for y"
				b := TCube new.
				i>0 ifTrue: [b colorize: Color green].
				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'!

!GridWorldDemo5x5 methodsFor: 'as yet unclassified' stamp: 'strick 6/30/2007 14:53'!
demoSize

	"A 5x5 world is more interesting demo; it takes a while to explore 25 parcels."

	^ 5 @ 5! !


TSpace subclass: #GridWorldEntrySpace
	instanceVariableNames: 'parcels'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!GridWorldEntrySpace methodsFor: 'accessing' stamp: 'strick 7/10/2007 02:02'!
parcels
	"Answer the value of parcels"

	^ parcels! !

!GridWorldEntrySpace methodsFor: 'accessing' stamp: 'strick 7/11/2007 01:15'!
parcelsValues

	^ parcels values! !

!GridWorldEntrySpace methodsFor: 'accessing' stamp: 'strick 7/10/2007 02:02'!
parcels: anObject
	"Set the value of parcels"

	parcels := anObject! !


Object subclass: #MatterCompiler
	instanceVariableNames: 'spaceRef objects httpPrefix urlPrefix mcId after eventLoop quit hectare harness pushQ'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!MatterCompiler methodsFor: 'private' stamp: 'strick 4/7/2007 01:57'!
instantiate: description
	| id objRef |

	id := description matterId.
	"objRef := MatterRef new ref: (spaceRef island new: description matterClass); yourself."
	objRef := MatterRef new ref: (spaceRef island send: [:o| o new: description matterClass]); yourself.
	self thingsRef   future    addChild: objRef.
	"objRef ref future position: description position.   --etc"
	
	objects at: id put: objRef.

	
! !

!MatterCompiler methodsFor: 'private' stamp: 'strick 3/31/2007 14:21'!
random24

	^ ((TObjectID new: 4) unsignedLongAt: 1) bitAnd: 16rFFFFFF! !


!MatterCompiler methodsFor: 'http' stamp: 'strick 8/19/2007 17:42'!
doCommand: words

	| objId field value objRef |

	words size < 4 ifTrue: [
		Grid note: 'Bad command: ' , words asString.
		^ self. ].
	objId := words at: 2.
	field := words at: 3.
	value := words at: 4.
	
	field = 'C' ifTrue: [
		harness avatar replica future sayWhat: '(((', value, ')))'.
	].
	field = 'A' ifTrue: [ |args|
		(objects includesKey: objId) ifFalse: [
			objRef := spaceRef future makeName: 'id',objId  shape:  #cylinder.  """FUTURE"""
			objects at: objId put: objRef.
		] ifTrue: [ objRef := objects at: objId. ].
		args := value findTokens: $; .  " args is 'x;y;z;r;s;t' for location then rotation "
		objRef future objectName: args first.
		args := args allButFirst collect: [ :o | o asNumber ].
		objRef future gtPos: args first @ args second @ args third.
		"next come rotation; we dont use them yet."
	].		
	field = 'k'  ifTrue: [ "we abuse the 'kind' message for instantiate. "

		(objects includes: objId) ifTrue: [ self debug. ]. "---- should not occur, but did -----"

		objRef := spaceRef future makeName: 'id',objId  shape:  value asSymbol.
		objects at: objId put: objRef.
	].
	field = 'l'  ifTrue: [ "location and rotation"
		| args |
		args := value findTokens: $; .  " args is 'x;y;z;r;s;t' for location then rotation "
		args := args collect: [ :o | o asNumber ].
		objRef := objects at: objId ifAbsent: [nil].
		objRef ifNotNil: [
			objRef future gtPos: args first @ args second @ args third + (50@50@0).
			objRef future gtRot: args fourth @ args fifth @ args sixth.
		]
	].
	field = 's'  ifTrue: [ "size and color"
		| args |
		args := value findTokens: $; .  " args is 'x;y;z;r;s;t' for location then rotation "
		args := args collect: [ :o | o asNumber ].
		objRef := objects at: objId ifAbsent: [nil].
		objRef ifNotNil: [
			objRef future gtSize: args first @ args second @ args third.
			objRef future gtColor: args fourth @ args fifth @ args sixth.
		]
	].
	^ objRef! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 7/22/2007 22:28'!
httpCallPush

	| u z x |

	[
		x := pushQ nextOrNil.
		x notNil
	]
	whileTrue: 
	[

		u := urlPrefix, 'put?mc=', mcId asString.

		hectare ifNotNil: [ u := u, '&h=', hectare. ].
		u := u, x.

Grid note: 'PUSH<<< ', u.
		Grid webMutex: [z := HTTPClient httpGet: u.].
Grid note: 'PUSH>>> ', z contents.
	].
! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 7/22/2007 22:31'!
httpCallPushAvatar

	| spaceName u pos |

	hectare ifNil: [^self].

	spaceName := Grid ask: #objectName ofRef: harness activeSpace.
	spaceName ifNil: [^self].
	spaceName = hectare ifFalse: [^self]. "only the correct space should report avatar"
	
	pos := harness avatarPositionInGrid.
	pos ifNil: [^self].

	u := urlPrefix, 'slsensor?mc=', mcId asString, '&h=', hectare.
	u := u, '&name=', harness userName asString.


	u := u, '&pos=', 
		pos x asString, ';', 
		pos y asString, ';', 
		pos z asString, '&rot=0;0;0'.

	Grid webMutex: [ HTTPClient httpGet: u. ].


! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 7/22/2007 22:21'!
httpCallSync

	| u z |
	u := urlPrefix, 'sync?',
		'mc=', mcId asString,
		'&after=', after asString,
		'&max=12&sync=1' .

	hectare ifNotNil: [ u := u, '&h=', hectare. ].

	Grid webMutex: [ z := HTTPClient httpGet: u. ].

	^ z



! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 7/11/2007 22:24'!
startEventLoop
	self stopEventLoop.
	eventLoop := self fork: #synchronizeFromGridEventLoop at: Processor userSchedulingPriority + 0.! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 3/31/2007 15:17'!
stopEventLoop
	eventLoop ifNotNil:[eventLoop terminate].
	eventLoop := nil.! !

!MatterCompiler methodsFor: 'http' stamp: 'strick 8/19/2007 18:34'!
synchronizeFromGridEventLoop
"<<
	self new synchronizeFromGridEventLoop
>>"
	
	| commands n |
	n := 0.
	"Delay forMilliseconds: (Random new nextInt: 5000)."

	[true] whileTrue: [
		[
			quit ifTrue: [^self].
self flag: #strick23.
"<<
			self httpCallPush.  -- sneak the Push in here --
>>"
			n := n + 1. " try to slow down pushes, so not every time "
			((n\\8) = 0) ifTrue: [ self httpCallPushAvatar. ].
			commands := self httpCallSync contents findTokens: String crlf.
Grid noten: ' (SIZE = ', commands size asString,') '.

			commands size > 0 
		]
		whileTrue: [
			"commands do: [ :s | self doCommand: (s findTokens: Character space) ]."
			commands do: [ :s | | words | 
"Grid note: 'COMMAND = ', s."
				words := s findTokens: Character space.
				words size = 4 ifTrue: [


					"only set after if it advances in time"
					"TODO: should we ignore it, if it goes backwards?  Why do we see that?"
					(words first > after) ifTrue: [
"Grid note: 'First=', words first, ';;;After=', after."
						after := words first. 
"Transcript nextPutAll: (after, ';')."
					]
						ifFalse: [ self debug. ].
					

"Grid note: 'AFTER = ', after."
					harness enqueueSomeWork: ( 
						MatterCompilerCommand new mc: self words: words).
				]
			].
			harness delayForSeconds: 1.
		].
		harness delayForSeconds: 1.
	]! !


!MatterCompiler methodsFor: 'initialize' stamp: 'strick 7/22/2007 22:22'!
initialize

	pushQ := SharedQueue new.
	super initialize.
	objects := Dictionary new.
	mcId := 1000000 + self random24.

	urlPrefix := 'http://sybil.yak.net:30306/'.
	urlPrefix := 'http://127.0.0.1:30306/'.

	after := '0'.
	quit := false.

! !

!MatterCompiler methodsFor: 'initialize' stamp: 'strick 7/17/2007 20:12'!
push: item

	pushQ nextPut: item! !


!MatterCompiler methodsFor: 'accessing' stamp: 'strick 7/12/2007 23:49'!
harness: aGridHarness

	harness := aGridHarness! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 7/10/2007 15:45'!
hectare

	^ hectare
	! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 7/10/2007 15:44'!
hectare: h

	hectare := h
	! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 7/2/2007 21:08'!
quit

	quit := true.! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 3/31/2007 17:01'!
spaceRef

	^ spaceRef! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 3/31/2007 17:01'!
spaceRef: aSpace

	spaceRef := aSpace! !

!MatterCompiler methodsFor: 'accessing' stamp: 'strick 3/31/2007 17:04'!
thingsRef

	^ spaceRef get: #things! !


Object subclass: #MatterCompilerCommand
	instanceVariableNames: 'mc words'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!

!MatterCompilerCommand methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 23:47'!
mc: aMatterCompiler words: anArray

	mc := aMatterCompiler.
	words := anArray.
! !

!MatterCompilerCommand methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 23:48'!
perform

	mc doCommand: words
! !


Object subclass: #MatterRef
	instanceVariableNames: 'ref mc'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grid-Croquet'!
!MatterRef commentStamp: '<historical>' prior: 0!
This class is NOT USED.

I keep it around because it begins me on the pattern #onPositionChanged:
which I need to use soon.
!


!MatterRef methodsFor: 'initialize' stamp: 'strick 3/31/2007 13:28'!
mc

	^ mc! !

!MatterRef methodsFor: 'initialize' stamp: 'strick 3/31/2007 13:27'!
mc: aMatterCompiler

	mc := aMatterCompiler! !

!MatterRef methodsFor: 'initialize' stamp: 'strick 3/31/2007 13:25'!
onPositionChanged: newPosition
	"talk to matter compiler"! !

!MatterRef methodsFor: 'initialize' stamp: 'strick 3/31/2007 13:29'!
ref

	^ ref! !

!MatterRef methodsFor: 'initialize' stamp: 'strick 3/31/2007 13:25'!
ref: aRef
	ref := aRef.
	self startScript: #onPositionChanged: when: {aRef. #positionChanged}.! !