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

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

Grid class
	instanceVariableNames: ''!

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

	MutexObject ifNil: [ MutexObject := TMutex new ].

	MutexObject critical: aBlock.
! !

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 19:01'!
logn: something

	MutexObject ifNil: [ MutexObject := TMutex new ].

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

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 19:01'!
log: something

	MutexObject ifNil: [ MutexObject := TMutex new ].

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

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 19:08'!
noten: something

	MutexObject ifNil: [ MutexObject := TMutex new ].

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

!Grid class methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 19:08'!
note: something

	MutexObject ifNil: [ MutexObject := TMutex new ].

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

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


KStandardHarness subclass: #GridHarness
	instanceVariableNames: 'rand mc spacesRendered workQueue spacesQueueToBeStarted spacesSetToBeStarted'
	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/13/2007 01:02'!
doSomeWork

	| aJob |
	aJob := workQueue nextOrNil.

	aJob ifNotNil: [

		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/13/2007 21:40'!
initialize

	rand := Random 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/10/2007 15:52'!
junk

	| as ref spaceName |
	ref := nil.
	as := self activeSpace.
	spaceName := as syncSend: #objectName withArguments: #().
	mc := MatterCompiler new.

	mc spaceRef: as.
     mc hectare: spaceName.

"------
	ref := mc doCommand: { 'T12345'.  '222'.  'k'.  'cube'. }.
	ref := mc doCommand: { 'T12345'.  '222'.  'l'.  '48;48;2;0;0;1'. }.
	ref := mc doCommand: { 'T12345'.  '222'.  's'.  '0.2;0.2;2.0;0.8;0.2;0.8'. }.

	ref := mc doCommand: { 'T12346'.  '223'.  'k'.  'sphere'. }.
	ref := mc doCommand: { 'T12346'.  '223'.  'l'.  '47;47;1;0;0;1'. }.
	ref := mc doCommand: { 'T12346'.  '223'.  's'.  '0.2;0.2;2.0;0.2;0.5;0.8'. }.
-------"
	mc startEventLoop.
	^ ref
 ! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/2/2007 09:37'!
junk2
	
	MC := MatterCompiler new.
	MC startEventLoop.
	^ MC! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/1/2007 17:39'!
makeThings: n

	^ (1 to: n) collect: [ :i |
		self activeSpace 
			syncSend: #makeName:shape:pos:size:rot:color:texture:
			withArguments: {
				('obj', i asString, 'of', n asString).
				#cube.
				(self randPt) * 10 + (30@30@0).
				(self randPt) * 2.
				0@0@0.
				Color colorFrom: (self randPt).
				#texture.
			}
	]
! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/2/2007 09:26'!
mc
	^ mc! !

!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/13/2007 00:41'!
rememberSpaceRendered: aSpace

	| aSpaceRef |

	"We only want GridThingsSpaces."
	(aSpace class inheritsFrom: GridThingsSpace) ifFalse: [ ^self ].


	aSpaceRef := Processor activeIsland asFarRef: aSpace.

	(spacesRendered includes: aSpaceRef) ifTrue: [

		"already in there"

	] ifFalse: [

		self flag: #strick. "TODO -- dont execute this inside island (from GridPortal3D>>render:ogl)"

		"new space discovered"
		spacesRendered add: aSpaceRef.

		"<<self startMatterCompilerOn: aSpaceRef.>>"

		mc := MatterCompiler new.
		mc spaceRef: aSpaceRef.
		mc harness: self.
		
		mc hectare: aSpace objectName.

Grid note: 'MC ', mc asString, ' SPACE ', aSpace asString, ' NAME ', aSpace objectName.

		mc startEventLoop.

	].! !

!GridHarness methodsFor: 'as yet unclassified' stamp: 'strick 7/14/2007 01:41'!
renderWorld

	| s |

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

		self startMatterCompilerOnSpaceRef: s.

	] ifNil: [ "or we can do one unit of work"

		"-- new style is spacesRendered -- do some work from it. --"
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
		self doSomeWork.
	].

	^ super renderWorld! !

!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 7/13/2007 22:07'!
startMatterCompilerOnSpaceRef: aSpaceRef


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

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

Grid note: 'NEW MC ', mc asString, ' SPACE ', aSpaceRef asString, ' NAME ', name.

	mc startEventLoop.
! !

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

!GridMenuBar methodsFor: 'as yet unclassified' stamp: 'strick 7/12/2007 19:10'!
actionConnectToGrid

	| as mc asClass |
as := self harness activeSpace.
asClass := as syncSend: #class withArguments: #().

asClass == GridWorldEntrySpace ifTrue: [ 
  "if in entry space, do it for ALL spaces"
  (as syncSend: #parcelsValues withArguments: #()) do: [ :s |

	mc := MatterCompiler new.
	mc spaceRef: s.
	name := s syncSend: #objectName withArguments: #().
	mc hectare: name.

Grid note: 'MC ', mc asString, ' SPACE ', s asString, ' NAME ', name.

	mc startEventLoop.
  ].

] ifFalse: [
	mc := MatterCompiler new.
	mc spaceRef: as.
	name := as syncSend: #objectName withArguments: #().
	mc hectare: name.


Grid note: 'MC ', mc asString, ' SPACE ', as asString, ' NAME ', name.

	mc startEventLoop.

]! !

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

	^ hand world ownerMorph harness
! !

!GridMenuBar methodsFor: 'as yet unclassified' stamp: 'strick 7/13/2007 21:47'!
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: ''
	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/12/2007 23:24'!
initialize

	"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

! !

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


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

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 6/30/2007 13:48'!
gtShape: s

	| guts |
	self removeAll.

	s == #cube ifTrue: [
	  guts := TCube new.
	].
	s == #sphere ifTrue: [
	  guts := TSphere new.
	].

	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/12/2007 19:43'!
initialize

	super initialize.
	solid := true.

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

	self gtUpdatePosSizeRot.
	self gtShape: #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 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/1/2007 17:27'!
makeName: name shape: shape pos: pos size: sz rot: rot color: c texture: txt

	| t |
	t := GridThing new.
	t objectName: name.
	t gtShape: shape.
	t gtPos: pos size: sz rot: rot.
	t gtColor: c.
	" dont do texture yet "

	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 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/12/2007 19:02'!
initializeWithMaster: m atGridCoordinate: aPoint

	
	Grid logn: ' [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/11/2007 00:32'!
makeStuff

	| a b |
	a := gridCoordinate x.
	b := gridCoordinate y.

	things addChild: (GridBoundary new translation: 50@50@0.1; yourself).

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

"<<
	((a<4) and: [b<4]) ifTrue: [
		wheel := Color wheel: 21.
		5 to: 96 by: 5 do: [ :j | self make: TSphere x: 7+(a*10) y: j z: 1 radius: 0.9 color: (wheel at: j//5+1) ].
	].
	(a<3) ifTrue: [
		wheel := Color wheel: gridConfig ySize.
		 5 to: 96 by: 5 do: [ :j | self make: TCube 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.

	t := GridThing new.
	t objectName: 'thing1'.
	t gtPos: 52 @ 52 @ 2.
	t gtColor: Color gray.
	things addChild: t.
>>"
	
"<<	((a=3) and: [b=3]) ifTrue: [
		self explore.
		things removeAll.
		self frameChildren do: [ :fc | 
				fc class name = #TCube ifTrue: [ self removeChild: fc ]
		].
	].
>>"

! !

!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/10/2007 02:02'!
initialize
	| space sky 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. "get going"
	space addChild: sky.

"toys"
	self createAxes: space.

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

	self linkParcels.

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

	^ space! !

!GridWorld methodsFor: 'as yet unclassified' stamp: 'strick 7/11/2007 00:53'!
initializeParcels: space

	| 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 7/13/2007 00:32'!
linkParcels

	| toCoord tg diam |
	0 to: gridConfig xSize-1 do: [ :x |
	 	0 to: gridConfig ySize-1 do: [ :y |
			| from to  p |
			Grid noten: '[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/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 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! !

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