-----------------------------------------------------------------------------
Object subclass: #BaseWorld
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: 'OpenGLConstants'
	category: 'HedgeHacks-BFD'!
-----------------------------------------------------------------------------
!BaseWorld commentStamp: '<historical>' prior: 0!
Base world constructor with a few utility methods.!
-----------------------------------------------------------------------------
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.
-----------------------------------------------------------------------------
BaseWorld subclass: #WisconsinWorld
	instanceVariableNames: 'floorOffset floor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Wisconsin-Worlds'!
- 
buildTerrain: textureName: uvScale: scale: space: 
 - 
- 
WisconsinWorld class {as yet unclassified}
 - 
buildTerrain: terrain textureName: fileName uvScale: uvScale scale: scale space: space 
	| texture | 
	texture :=  TTexture
					new initializeWithFileName: fileName
					mipmap: true
					shrinkFit: false.
	texture uvScale: uvScale.
	terrain genGrid.
	terrain buildMeshWithTexture: texture.
	terrain boundsDepth: 2.
	terrain initBounds.
	terrain scale: scale.
	^TTerrainQuadTree new initializeWithSpace: space frame: terrain.
 
 
- 
createAxes: 
 - 
- 
GridWorld {as yet unclassified}
 - 
createAxes: space
	
	space addChild: TFrame new.
	space addChild: (TFrame new translation: gridConfig parcelRadius @ gridConfig parcelRadius @ 0; yourself).
 
 
- 
gridConfig 
 - 
- 
GridWorld {initialize}
 - 
gridConfig
	^ gridConfig! !
 
 
- 
gridScale 
 - 
- 
GridWorld {initialize}
 - 
gridScale
	^ gridConfig gridScale! !
 
 
- 
initialize 
 - 
- 
GridWorld {as yet unclassified}
 - 
initialize
	| space sky flr |
"CONFIGRUABLE CONSTANTS"
	gridConfig := GridConfig new xSize: 5 ySize: 5 parcelRadius: 50 gridScale: 5.
"space"
	gridPortals := Dictionary new.
	space := TSpace new.
	space registerGlobal: #mainEntry.
"light"
	self makeLight: space.
"floor -- must be local flr, not inst var floor, because Wisc wants to send #contents to floor"
	flr := self makeFloor: space fileName: 'lawn.bmp'.
	flr extentX: 100 y:0.5 z: 100.
"sky"
	sky := TSkyBox new initializeWithFileName: 'GRS'.
	sky step. "get going"
	space addChild: sky.
"toys"
	self createAxes: space.
"parcels"
	self initializeParcels: space.
	self linkParcels.
	^ space! !
 
- 
WisconsinWorld {initialize}
 - 
initialize
	| space sky |
	Processor activeIsland id: self class islandID.
	space := TSpace new.
	space registerGlobal: #mainEntry.
	self makeLight: space.
	floorOffset :=  0.0.
	self initializeFloor: space.
	sky := KSkyBox new initializeWithFileName: 'GRS'.
	space addChild: sky.
	self initializeToys: space.
	sky stepInterval: 50.
	sky step. "get going"
	^space.
 
 
- 
initializeCommonPortals: 
 - 
- 
GridWorld {initialize}
 - 
initializeCommonPortals: space
	| portal x |
	"--- TODO(strick) Move this to grid coordinates ---"
	x := 20.
	{ WisconsinWorld. GridWorld. } do: [ :worldClass |
		self makeOnePortal: worldClass textureFileName: 'logo.png' scale: 2 position: x@5@-20 space: space.
		"-- TODO -- request that above method return the new portal --"
		portal := space frameChildren last.  "-- assuming it is the last --"
		portal objectName: 'Portal_to_', worldClass name.
		x := x + 20.
	].
 
 
- 
WisconsinWorld {initialize}
 - 
initializeCommonPortals: space
	self makeOnePortal: WisconsinWorld textureFileName: 'logo.png' scale: 2 position: 0@0@-20 space: space.
 
 
- 
initializeFloor: 
 - 
- 
WisconsinWorld {initialize}
 - 
initializeFloor: space
	"self makeFloor: space fileName:'lawn.BMP'."
	self initializeTerrain: space.! !
 
 
- 
initializeParcels: 
 - 
- 
GridWorld {as yet unclassified}
 - 
initializeParcels: space
	| wheel spoke |
	parcels := Dictionary new.
	wheel := Color wheel: gridConfig xSize * gridConfig ySize.
	spoke := 1.
	0 to: gridConfig xSize-1 do: [ :x |
	 	0 to: gridConfig ySize-1 do: [ :y |
			| s p w |
			s := nil.
			s := GridParcelSpace new initializeWithMaster: self atGridCoordinate: x@y.
			s objectName: 'GridParcelSpace_', x asString, '_', y asString.
			self makeRingOfCubesInNewCoords: s things color: (wheel at: spoke).
			self createAxes: s things.
			s makeStuff. "like roads & houses & stuff"
			"-- make a portal in the Foyer World to enter each grid parcel --"
			w := self makePortal: 'lawn.bmp'.
			w objectName: 'Portal_into_', x asString, '_', y asString.
			p := w contents.
			p objectName: 'Postcard_into_', x asString, '_', y asString.
			p postcardLink: s postcard.
			w extent: 5@5.
			w translation: (10*x-17) @ 0 @ (0-10*y-15).
			space addChild: w.
			self initializeCommonPortals: s.
			self makeFloor: s 
				fileName: 'lawn.bmp' 
				radius: gridConfig parcelRadius * gridConfig gridScale.
			self makeLight: s.
			parcels at: x@y put: s.
			spoke := spoke+1.
		]
	]
 ! !
 
 
- 
initializeTerrain: 
 - 
- 
WisconsinWorld {initialize}
 - 
initializeTerrain: space
	floor := self class buildTerrain: (TFractalTerrain  initializeSize: 32 
								smoothness: self terrainSmoothness
								heightScale: self terrainHeightScale
								randomSeed: self terrainSeed)
				textureName: self terrainTextureName
				uvScale: self terrainUVScale
				scale: 500
			 	space: space.
	floorOffset :=  (floor contents heightAt: 0@0).
	floor translation: 0@(-3 - floorOffset)@0.
	floor addRotationAroundY: 0.4. "Avoid travelling in seams that we fall through."
	^floor.! !
 
 
- 
initializeToys: 
 - 
- 
WisconsinWorld {initialize}
 - 
initializeToys: space
	self makeOnePortal: WisconsinNextWorld1 textureFileName: 'caust31.BMP' scale: 3 position: -25@0@-20 space: space.
	self makeOnePortal: ForensicsWorld textureFileName: 'graph128.bmp'     scale: 2 position: -15@0@-20 space: space.
	self makeOnePortal: UWIntroWorld textureFileName: 'GrnChplTwr.bmp'   scale: 2 position: -5@0@-20 space: space.
	self makeOnePortal: QuiltersWorld textureFileName: 'checker.png'        scale: 2 position: 5@0@-20 space: space.
	self makeOnePortal: CritiquetWorld textureFileName: 'default.bmp'      scale: 4 position: 15@0@-20 space: space.
	self makeOnePortal: WisconsinNextWorld2 textureFileName: 'floor.bmp' scale: 2 position: 25@0@-20 space: space.
 
 
- 
islandID 
 - 
- 
GridWorld class {as yet unclassified}
 - 
islandID
	^TObjectID readHexFrom: '1f2f349874e53ebe785f681585111111'! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:39:34 pm'!
 
- 
WisconsinWorld class {accessing}
 - 
islandID
	^TObjectID readHexFrom: 'c2be09189969d56cc3073ec4d256cb6d'! !
 
 
- 
linkParcels 
 - 
- 
GridWorld {as yet unclassified}
 - 
linkParcels
	| toCoord tg diam |
	0 to: gridConfig xSize-1 do: [ :x |
	 	0 to: gridConfig ySize-1 do: [ :y |
			| from to  p |
			from := parcels at: x@y.
			self makeRedBlueLandmarksIn: from x: x y: y.
			"-- now the actual edge portals --"
			diam := gridConfig gridScale * 2 * gridConfig parcelRadius.
	1 negated to: 1 do: [ :i |
		1 negated to: 1 do: [ :j |
			(i~=0 or: [j~=0]) ifTrue: [
		
			toCoord := (x+i+gridConfig xSize\\gridConfig xSize) @ (y+j+gridConfig ySize\\gridConfig ySize).
			to := parcels at: toCoord.
			p := GridPortal3D new.
			p extent: diam@diam. "strangely, TPortal3D>>extent: actually only uses the x value"
			p scale: 1.0 .  "default was to shrink -- we dont want that"
			p postcardLink: to.
			tg := TGroup new.
			tg translation: (i*diam) @ 0 @ (j*diam)negated. "in croquet coords, not Grid's"
			tg addChild: p.
			from addChild: tg.
	]]].
	]]
 
 
- 
makeFloor: fileName: 
 - 
- 
BaseWorld {toys}
 - 
makeFloor: sp fileName: txtrName
	| stone txt mat |
	txt := TTexture
				new initializeWithFileName: txtrName
				mipmap: true
				shrinkFit: false.
	txt uvScale: 8.0@8.0.
	mat := TMaterial new.
	mat texture: txt.
	stone := TCube new.
	stone extentX:80 y:0.5 z: 80.
	stone translationX: 0 y: -6.0 z: 0.0.
"	stone texture: txt."
	stone material: mat.
	stone objectName: 'floor' copy.
	sp addChild: stone.
	^ stone.
 
 
- 
makeFloor: fileName: radius: 
 - 
- 
GridWorld {initialize}
 - 
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.
 
 
- 
makeLight: 
 - 
- 
BaseWorld {toys}
 - 
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 {as yet unclassified}
 - 
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.! !
 
 
- 
makeMorphic: extent: 
 - 
- 
BaseWorld {toys}
 - 
makeMorphic: constructor extent: worldExtent
	| morphic txtr fakeSHA |
	fakeSHA := TFormManager generateSHA: (TObjectID for: 'SHA').
	morphic := TMorphicForm new 
		initialize: nil sha: fakeSHA 
		form: (Form extent: 32@32 depth: 32)
		mipmap: false shrinkFit: true extension: nil. 
	morphic bThumb: true.
	morphic constructor: constructor.
	morphic worldExtent: worldExtent.
	"@@@@ The following is VERY important since later we'll need the TMorphic's farRef but we cannot create it in render, so forcing it here is a must @@@@"
	morphic island asFarRef: morphic.
	txtr := TTextureHackForm new initializeWithTForm: morphic.
	txtr targetExtent: worldExtent.
	^txtr! !
 
 
- 
makeOnePortal: textureFileName: scale: position: space: 
 - 
- 
WisconsinWorld {initialize}
 - 
makeOnePortal: aClass textureFileName: aString scale: aNumber position: aVector space: space
	| portal |
	portal := self makePortal: aString.
	portal extent: portal extent * aNumber.
	portal contents postcardLink: (TPostcard new 
									routerAddress: nil
									id: aClass islandID
									name: aClass name asString
									viewpointName: #mainEntry).
	self position: portal at: aVector.
	portal addRotationAroundY: 0.5.
	space addChild: portal.
 
 
- 
makePortal: 
 - 
- 
BaseWorld {toys}
 - 
makePortal: textureName
	| p1 win pic |
	p1 := TPortal new.
	win := self makeWindow.
	win contents: p1.
	textureName ifNotNil:[
		pic := TTexture
					new initializeWithFileName: textureName
					mipmap: true
					shrinkFit: false.
		win rectFront: pic.
	].
	win closeContents.
	win showOpenButton.
	^win! !
 
 
- 
makePortal: from: to: 
 - 
- 
GridWorld {as yet unclassified}
 - 
makePortal: aTextureName from: gridCoordinateFrom to: gridCoordinateTo
	| p |
	p := self makePortal: aTextureName.
	gridPortals at: {gridCoordinateFrom. gridCoordinateTo.} put: p.
	^p.
 
 
- 
makeRedBlueLandmarksIn: x: y: 
 - 
- 
GridWorld {initialize}
 - 
makeRedBlueLandmarksIn: space x: x y: y
			"-- make landmarks in parcel --"
			0 to: x do: [ :i | | b |   "red for x"
				b := TCube new.
				b colorize: Color red.
				b translation: -5 @ (1+i*1.5) @ -15.
				space addChild: b.
			].
			0 to: y do: [ :i | | b |  "blue for y"
				b := TCube new.
				b colorize: Color blue.
				b translation: -3 @ (1+i*1.5) @ -15.
				space addChild: b.
			].
 
 
- 
makeRingOfCubesInNewCoords: color: 
 - 
- 
GridWorld {as yet unclassified}
 - 
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.
	]! !
 
 
- 
makeWidget: scale: 
 - 
- 
BaseWorld {toys}
 - 
makeWidget: uri scale: scl
	| frame fileName |
	fileName := FileDirectory pathFromURI: uri.
	frame := (TLoad3DSMax new initializeWithFileName: fileName scale: scl) frame.
	frame boundsDepth: 1.
	frame initBounds.
	frame do:[ :tf |
		tf isMesh ifTrue:[ tf materialList do:[ :ml |
			ml ambientColor: #(0.2 0.5 1.0 0.8).
			ml diffuseColor:#(0.2 0.5 1.0 0.8).
			ml textureMode: GLModulate.
		]].
		tf checkAlpha.
	].
	^frame! !
 
 
- 
makeWindow 
 - 
- 
BaseWorld {toys}
 - 
makeWindow
	"Already has a cache mechanism in class #new.
	However, this is overrideable by BaseWorld subclasses."
	^TWindow new.! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:39:30 pm'!
 
- 
WisconsinWorld {toys}
 - 
makeWindow
	^KMedia2DContainer newOn: self island.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
WisconsinWorld class
	instanceVariableNames: ''!
 
 
- 
parcelRadius 
 - 
- 
GridWorld {initialize}
 - 
parcelRadius
	^ gridConfig parcelRadius! !
 
 
- 
parcels 
 - 
- 
GridWorld {initialize}
 - 
parcels
	^ parcels! !
 
 
- 
position: at: 
 - 
- 
WisconsinWorld {initialize}
 - 
position: anObject at: aTranslation
	floor ifNil: [^anObject translation: aTranslation].
	anObject translation: aTranslation x @ 
				((floor contents heightAt: aTranslation x @ aTranslation z) - floorOffset)@
				aTranslation z.
	
	! !
 
 
- 
position: on: at: 
 - 
- 
WisconsinWorld {initialize}
 - 
position: anObject on: aTerrain at: aTranslation
	anObject translation: aTranslation x @ 
				((aTerrain contents heightAt: aTranslation x @ aTranslation z) - floorOffset)@
				aTranslation z.
	
	! !
 
 
- 
terrainHeightScale 
 - 
- 
WisconsinWorld {initialize}
 - 
terrainHeightScale
	^0.3! !
 
 
- 
terrainSeed 
 - 
- 
WisconsinWorld {initialize}
 - 
terrainSeed
	^12345! !
 
 
- 
terrainSmoothness 
 - 
- 
WisconsinWorld {initialize}
 - 
terrainSmoothness
	^0.8! !
 
 
- 
terrainTextureName 
 - 
- 
WisconsinWorld {initialize}
 - 
terrainTextureName
	^'lawn.BMP'! !
 
 
- 
terrainUVScale 
 - 
- 
WisconsinWorld {initialize}
 - 
terrainUVScale
	^20@20! !
 
 
- 
xSize 
 - 
- 
GridWorld {initialize}
 - 
xSize
	^ gridConfig xSize! !
 
 
- 
ySize 
 - 
- 
GridWorld {initialize}
 - 
ySize
	^ gridConfig ySize! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
GridWorld class
	instanceVariableNames: ''!