-----------------------------------------------------------------------------
Object subclass: #CroquetHarness
instanceVariableNames: 'myEventMap userID dispatcher controllers contactPoint formMgr cacheMgr avatar ogl viewPortal postcard bounds systemOverlayPortal systemOverlay systemIsland readyToRender renderProcess doRender viewpoints eventPointer event yellowButtonPressed redButtonPressed overlays islandsByName islandsByID enableIslandCache snapshots windowData task taskStack lastCameraTransform activeSpace allowControllerAliasing embeddedApps'
classVariableNames: ''
poolDictionaries: 'OpenGLConstants'
category: 'Croquet-Harness'!
-----------------------------------------------------------------------------
!CroquetHarness commentStamp: '<historical>' prior: 0!
Croquet Harness is the minimal interface to the underlying support infrastructure. It is used to manage changes in screen real estate, and track events to vector to Croquet.
userID - a unique TObjectID which identifies a particular user.
dispatcher -
controllers - collection of controllers that we have created that are connected to both the local and remote routers.
contactPoint - finds all of the local broadcasting routers via their own contectPoints.
formMgr - the default TFormManager. used to manage TForms.
cacheMgr - default TFileCachManager.
avatar - TAvatarUser
ogl - the OpenGL object, which is the interface to OpenGL.
viewPortal - the main viewing portal into the current space of interest
postcard - a TPostcard that is a reference for the rendered viewpoint.
bounds - the 2D bounds of the viewing space
systemOverlayPortal - overlay portal supporting the system overlay space
systemOverlay - system overlay space
systemIsland - the non-replicated Island containing the system overlay content
readyToRender - semaphore flag indicating that we can now render
renderProcess - a render process fork.
doRender - boolean indicating we can begin rendering
viewPoints - a listing of all the FarRe f viewpoints that are referenced by portals.
eventPointer - a TPointer used during rendering to determine user interactions with 3D objects.
event - a CroquetEvent object used to pass events to event processing objects inside of Croquet
yellowButtonPressed - boolean indicating yellow mouse button is pressed.
redButtonPressed - boolean indicating red mouse button is pressed.
overlays - array of overlay spaces passed to system to be rendered.
islandsByName - Dictionary used to look up Croquet Islands by their name.
islandsByID - Dictionary used to look up Croquet Islands by their ID.
enableIslandCache - enables checkpoint caching of Islands to disk.
snapshots - create image snapshots of current space.
windowData - holds a copy of a generic TWindow.
DAS!
-----------------------------------------------------------------------------
OpenALHarness subclass: #CroquetHarnessWithMenu
instanceVariableNames: 'blueButtonPressed listenerGain autoSave autoSaveProcess publishProcess propertiesFile'
classVariableNames: ''
poolDictionaries: ''
category: 'MenuUI-Harness'!
-----------------------------------------------------------------------------
KStandardHarness subclass: #GridHarness
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Grid-Croquet'!
-----------------------------------------------------------------------------
!GridHarness commentStamp: 'strick 3/21/2007 00:52' prior: 0!
I do not seem to be specializing GridHarness yet ... but I have a hunch that some day I will.!
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:51:40 pm'!
-----------------------------------------------------------------------------
KSDKHarness subclass: #KCacheHarness
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Wisconsin-Cache'!
-----------------------------------------------------------------------------
CroquetHarnessWithMenu subclass: #KSDKHarness
instanceVariableNames: ''
classVariableNames: 'FrameCache UseAlternateClasses'
poolDictionaries: ''
category: 'Wisconsin-SDK'!
-----------------------------------------------------------------------------
!KSDKHarness commentStamp: 'hrs 9/30/2006 17:32' prior: 0!
A lot of copied code, but with some hooks inserted so that we can customize things in subclasses. See comments in #initialize.!
-----------------------------------------------------------------------------
KCacheHarness subclass: #KStandardHarness
instanceVariableNames: 'userName password hud meshFrameData videoWindowData clipboard handleManager defaultErrorHandler watchdog'
classVariableNames: 'DefaultURL'
poolDictionaries: ''
category: 'Wisconsin'!
-----------------------------------------------------------------------------
!KStandardHarness commentStamp: 'jcg 9/16/2006 09:17' prior: 0!
Notes:
=======
- we use 'islandsByName' and 'islandsByID' differently than superclasses do: instead of storing islands in these dictionaries, we store controllers. The accessors #islandByName: and #islandByID: have been introduced in the superclasses, and are overridden here. This is done to support asynchronous (re-)loading of islands; if the controller does not yet have the island, its presence demonstrates that an effort is underway to load the island.!
-----------------------------------------------------------------------------
CroquetHarness subclass: #OpenALHarness
instanceVariableNames: 'openAL voiceRecorder voiceChats'
classVariableNames: ''
poolDictionaries: 'OpenALConstants'
category: 'OpenAL-Harness'!
-
aboutToRender
-
-
CroquetHarness {render}
-
aboutToRender
"This is an extension hook for subclasses.
Called in each render cycle, after avatar/camera position update
and just before the render: treewalk of the visible frame tree.
It is called during the locked-down phase of render,
so methods should be quick and may not change the replicated state.
(Originally used to update the avatar's OpenAL listener position
in the audio harness to match the avatar's current spatial position.)"
self signal: #aboutToRender.! !
-
activeIsland
-
-
CroquetHarness {islands}
-
activeIsland
"Answer the island we're currently on"
^self activeSpace island! !
-
activeIslandData
-
-
CroquetHarnessWithMenu {islands}
-
activeIslandData
^ (self activeSpace island get: #controller) snapshot! !
-
activeIslandName
-
-
CroquetHarnessWithMenu {islands}
-
activeIslandName
^ self activeSpace island get: #name.
-
activeSpace
-
-
CroquetHarness {accessing}
-
activeSpace
"Answer the space we're currently in"
^self findViewpointByPostcard: (viewPortal get: #postcardLink).! !
-
addContact:
-
-
KStandardHarness {accessing}
-
addContact: contact
(contactPoint ifNil: [contactPoint := TContactPoint new]) addContact: contact! !
-
addController:
-
-
CroquetHarness {accessing}
-
addController: aController
aController cacheManager: cacheMgr.
controllers add: aController.
self updateEmbeddedAppsIn: aController island.
-
addController: contact:
-
-
KStandardHarness {private-islands}
-
addController: controller contact: contact
"Stores controllers instead of islands into 'islandsByName' and 'islandsByID'; see class comment."
| name id |
name := contact name.
id := contact id.
Transcript show: 'ADDED ISLAND: ', name, ' ', id; cr.
self updateEmbeddedAppsIn: controller island.
name ifNotNil:[islandsByName at: name copy put: controller].
id ifNotNil:[islandsByID at: id copy put: controller].
-
addIsland: postcard:
-
-
CroquetHarness {islands}
-
addIsland: isl postcard: pc
| key |
(key := pc routerName) ifNotNil:[islandsByName at: key put: isl].
(key := pc routerID) ifNotNil:[islandsByID at: key put: isl].
-
KStandardHarness {islands}
-
addIsland: isl postcard: pc
| key controller |
controller := isl get: #controller.
(key := pc routerName) ifNotNil:[islandsByName at: key put: controller].
(key := pc routerID) ifNotNil:[islandsByID at: key put: controller].
-
addOverlay:
-
-
CroquetHarness {accessing}
-
addOverlay: overlay
overlays := overlays copyWith: overlay.! !
-
addPotentialLandmark
-
-
KStandardHarness {actions}
-
addPotentialLandmark
"Make a landmark of our current space and position IFF we don't already have some
landmark for this space.
Typically sent to add original position, and whenever we have just opened a portal
to a space that we have not yet visited. This algorithm ensures that we can get back
if we do visit it."
| newSpace newLandmark|
newSpace := self activeSpace.
snapshots do: [:landmark | landmark space = newSpace ifTrue: [^landmark]].
newLandmark := TSnapshot new space: newSpace
transform: (self avatar localTransform ifNil: [Matrix4x4 identity]).
snapshots add: newLandmark.
^newLandmark.! !
-
addToAvatarOrSpace:
-
-
KStandardHarness {actions}
-
addToAvatarOrSpace: newObj
| farAv class carrying |
farAv := self avatar replica.
newObj wait.
class := newObj get: #class.
farAv send: [:av | carrying := av isCarryingA: class.].
carrying
ifTrue: [^self activeSpace future addChild: newObj
byUser: farAv]
ifFalse: [newObj future nowCarried.
^farAv future carrying: newObj
].! !
-
addVoiceChat:
-
-
OpenALHarness {voice chat}
-
addVoiceChat: chatID
| chat |
openAL ifNil: [
^ nil
].
chat := TVoiceChat new.
chat source nameIn: openAL.
chat play: openAL.
self voiceChats at: chatID put: chat.
^ chat! !
-
allowControllerAliasing
-
-
CroquetHarness {accessing}
-
allowControllerAliasing
^allowControllerAliasing! !
-
allowControllerAliasing:
-
-
CroquetHarness {accessing}
-
allowControllerAliasing: aBool
allowControllerAliasing := aBool! !
-
archiveDirectory
-
-
KStandardHarness {accessing}
-
archiveDirectory
| fd |
fd := FileDirectory default directoryNamed: 'archive'.
fd assureExistence.
^fd! !
-
avatar
-
-
CroquetHarness {accessing}
-
avatar
^avatar! !
-
avatar:
-
-
CroquetHarness {accessing}
-
avatar: aTAvatarUser
avatar := aTAvatarUser.
avatar userID: userID.! !
-
bitCache
-
-
KCacheHarness {accessing}
-
bitCache
self flag: #jcg. "should rename iVar to 'bitCache'"
^ cacheMgr! !
-
bitCache:
-
-
KCacheHarness {accessing}
-
bitCache: aTBitCache
self flag: #jcg. "should rename iVar to 'bitCache'"
cacheMgr := aTBitCache! !
-
bounds
-
-
CroquetHarness {render}
-
bounds
^bounds! !
-
bounds:
-
-
CroquetHarness {render}
-
bounds: bnds
| xform |
ogl ifNil:[
ogl := OpenGL newIn: bnds.
ogl ifNil: [self error: 'Cannot initialize OpenGL.' ].
ogl harness: self.
ogl formManager: TFormManager default.
] ifNotNil:[
xform := ogl camera ifNotNil: [ogl camera localTransform.].
ogl := ogl bufferRect: bnds.
].
bounds := bnds translateBy: bnds origin negated.
ogl camera: TCamera new.
ogl avatar: avatar.
ogl camera bounds: bounds.
xform ifNotNil:[ ogl camera localTransform: xform.].
ogl camera initFrustum: ogl.
eventPointer parent: ogl camera.
viewPortal ifNotNil:[viewPortal send:[ :vp | vp bounds: bounds.]].
systemOverlayPortal ifNotNil:[systemOverlayPortal send:[ :so | (so resolveViewpoint:ogl) send:[ :spc | spc bounds: bounds.].].].
-
bounds: subBounds:
-
-
CroquetHarness {render}
-
bounds: bnds subBounds: sbnds
| sbounds |
ogl ifNil:[
ogl := OpenGL newIn: bnds.
ogl harness: self.
ogl formManager: TFormManager default.
] ifNotNil:[ ogl := ogl bufferRect: bnds. ].
bounds := bnds translateBy: bnds origin negated.
sbounds := sbnds translateBy: sbnds origin negated.
ogl camera: TCamera new.
ogl avatar: avatar.
ogl camera bounds: bounds.
ogl camera subBounds: sbounds.
ogl camera initFrustum: ogl.
eventPointer parent: ogl camera.
viewPortal ifNotNil:[viewPortal send:[ :vp | vp bounds: bounds.]].
systemOverlayPortal ifNotNil:[systemOverlayPortal send:[ :so | (so resolveViewpoint:ogl) send:[ :spc | spc bounds: bounds.].].].! !
-
cacheDirectory
-
-
CroquetHarness {accessing}
-
cacheDirectory
| fd |
fd := FileDirectory default directoryNamed: 'cache'.
fd assureExistence.
^fd! !
-
cacheManager
-
-
CroquetHarness {accessing}
-
cacheManager
^cacheMgr! !
-
cacheManager:
-
-
CroquetHarness {accessing}
-
cacheManager: aCacheManager
cacheMgr := aCacheManager! !
-
camera
-
-
CroquetHarness {accessing}
-
camera
^ogl camera! !
-
checkpointActiveIsland
-
-
CroquetHarnessWithMenu {islands}
-
checkpointActiveIsland
| fileName file |
true ifTrue: [Transcript show: 'checkpointing.';cr.].
fileName := self activeIslandName, '.c3d'.
file := self cacheDirectory forceNewFileNamed: fileName.
file binary.
[file nextPutAll: self activeIslandData] ensure: [file close].! !
-
cleanup
-
-
CroquetHarness class {class initialization}
-
cleanup
3 timesRepeat:[
Processor activeIsland flushGlobals.
Transcript show:(TIsland allInstances do:[:i | i flushGlobals.]);cr.
Transcript show:(TFarRef allInstances do:[:fr | fr destroy]);cr.
Transcript show:(CroquetHarness allInstances do:[:ch | ch destroy]);cr.
Transcript show:(TAvatarUser allInstances do:[:au | au destroy]);cr.
Transcript show:(TSimpleController allInstances do:[:sc | sc destroy]);cr.
Transcript show:(ScriptMessageSend allInstances do:[:sms | sms terminateScript]);cr.
Transcript show:(Smalltalk garbageCollect);cr.
]
-
clearFrameCache
-
-
KSDKHarness class {frame cache}
-
clearFrameCache
FrameCache := nil.! !
-
clearSounds
-
-
OpenALHarness {accessing}
-
clearSounds
openAL ifNotNil: [
openAL nameManager deleteAll.
].! !
-
clearStuff
-
-
KStandardHarness class {utility}
-
clearStuff
KLiveAudioSource clearSingleton.
KLiveVideoSource clearSingleton.
KClipboard clearDefault.
KSharedMediaCache clearDefault.
TFormManager clearDefault.
Smalltalk at: #TestingEventMap put: WeakIdentityKeyDictionary new.
Smalltalk at: #TestingScriptRegistry put: WeakIdentityKeyDictionary new.! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:51:49 pm'!
-
clipboard
-
-
KStandardHarness {accessing}
-
clipboard
^ clipboard! !
-
contactPoint
-
-
CroquetHarness {accessing}
-
contactPoint
^contactPoint! !
-
CroquetHarnessWithMenu {islandJoinHacks}
-
contactPoint
^contactPoint.! !
-
contactsByID
-
-
CroquetHarness {accessing}
-
contactsByID
^contactPoint contactsByID! !
-
contactsByName
-
-
CroquetHarness {accessing}
-
contactsByName
^contactPoint contactsByName! !
-
controllers
-
-
CroquetHarness {accessing}
-
controllers
^controllers! !
-
createIsland: named:
-
-
CroquetHarness {initialize}
-
createIsland: islandClass named: aString
"Create a new island. islandClass must be a class that is used to generate the contents of the TIsland. aString is a name for the router/island that allows another user to identify it. aBlock is executed upon completion and existence of the island. This is used to do additional setup with the island."
| p router controller id |
id := islandClass islandID.
"if a controller for this island has already been registered, just use that"
allowControllerAliasing ifTrue:[
controller := controllers detect:[:cc| cc sessionID = id and:[cc island == nil]] ifNone:[nil].
controller ifNotNil:[^self createIsland: islandClass named: aString using: controller].
].
"Create the dispatcher for any local islands we'd like to host the router for"
dispatcher ifNil:[
dispatcher := TExampleDispatcher new.
dispatcher listenOn: 0. "wildcard port"
dispatcher autoCreate: false.
].
"@@@@ FIXME: This is clearly not the way to do it @@@@"
router := TSimpleRouter new.
false ifTrue:[router log: Transcript].
router addUserName: 'foo' password: 'bar'.
dispatcher addRouter: router id: id.
contactPoint ifNil:[contactPoint := TContactPoint new].
contactPoint addBroadcast:(TContact new
address: dispatcher address port: dispatcher port
id: id name: aString).
"Create the controller"
controller := TSimpleController new.
controller connectTo: dispatcher address port: dispatcher port sessionID: id.
self addController: controller.
p := controller login: 'foo' password: 'bar'.
p wait. "not good style but easier for the setup"
p := controller join. "receive messages"
p wait. "see above"
controller backDoor: (dispatcher routers at: id).
^self createIsland: islandClass named: aString using: controller! !
-
CroquetHarnessWithMenu {initialize}
-
createIsland: islandClass named: aString
"TODO Stupid to override just to change the logger, fix this"
"Create a new island. islandClass must be a class that is used to generate the contents of the TIsland. aString is a name for the router/island that allows another user to identify it. aBlock is executed upon completion and existence of the island. This is used to do additional setup with the island."
| p island router controller id fileName file data sync |
id := islandClass islandID.
"Create the dispatcher for any local islands we'd like to host the router for"
dispatcher ifNil:[
dispatcher := TExampleDispatcher new.
dispatcher listenOn: 0. "wildcard port"
dispatcher autoCreate: false.
].
"@@@@ FIXME: This is clearly not the way to do it @@@@"
router := TRecordableRouter new.
false ifTrue:[router log: Transcript].
router addUserName: 'foo' password: 'bar'.
dispatcher addRouter: router id: id.
contactPoint ifNil:[contactPoint := TContactPoint new].
contactPoint addBroadcast:(TContact new
address: dispatcher address port: dispatcher port
id: id name: aString).
"This is stupid but I need a controller instance below to #restore: the island"
controller := TSimpleController new.
"Decide whether we need to recreate the island"
self enableIslandCache ifTrue:[
fileName := islandClass name,'.c3d'.
file := [self cacheDirectory readOnlyFileNamed: fileName]
on: FileDoesNotExistException
do:[:ex| ex return: nil].
file ifNotNil:[
"Load island from file"
file binary.
[data := file contents] ensure:[file close].
island := [controller restore: data] on: Error do:[:ex|
(UIManager default
chooseFrom: #('Ignore' 'Debug')
title: 'Could not load ', fileName,':\' withCRs, ex description) = 2
ifTrue:[Processor activeProcess debug: ex signalerContext
title: ex description full: true].
ex return: nil.
].
island ifNotNil:[
"@@@@ FIXME: How do we tell a router what its current time is? @@@@"
router timeStamp: (island get: #time).
].
].
].
controller connectTo: dispatcher address port: dispatcher port sessionID: id.
self addController: controller.
p := controller login: 'foo' password: 'bar'.
p wait. "not good style but easier for the setup"
p := controller join. "receive messages"
p wait. "see above"
controller heartbeat: 20.
controller beServer. "act as server"
controller backDoor: (dispatcher routers at: id).
island ifNotNil:[controller island: island].
island ifNil:[
"Create a new island"
island := controller newIsland. "Create a new island handled by the controller"
"the island must have the same id/name as the router to generate postcards"
island future id: id name: aString.
sync := island future new: islandClass.
self enableIslandCache ifTrue:[
sync wait.
"Make sure we don't interfere with render - render may hold a lock on the island which will not get released since this is the main thread being expected to signal readyToRender. Therefore we signal readyToRender right here to force it to render if a render operation was pending (if not, we fall right through this code)."
readyToRender signal.
readyToRender wait.
data := controller snapshot.
file := self cacheDirectory forceNewFileNamed: fileName.
file binary.
[file nextPutAll: data] ensure:[file close].
].
].
islandsByName at: aString put: island.
islandsByID at: id put: island.
^island! !
-
createIsland: named: using:
-
-
CroquetHarness {initialize}
-
createIsland: islandClass named: aString using: controller
"Create a new island. islandClass must be a class that is used to generate the contents of the TIsland. aString is a name for the router/island that allows another user to identify it. controller is the controller to use for the island"
| island id fileName file data sync p |
id := islandClass islandID.
controller heartbeat: 20.
controller beServer. "act as server"
"Decide whether we need to recreate the island"
self enableIslandCache ifTrue:[
fileName := islandClass name,'.c3d'.
file := [self cacheDirectory readOnlyFileNamed: fileName]
on: FileDoesNotExistException
do:[:ex| ex return: nil].
file ifNotNil:[
"Load island from file"
file binary.
[data := file contents] ensure:[file close].
island := [controller restore: data] on: Error do:[:ex|
(UIManager default
chooseFrom: #('Ignore' 'Debug')
title: 'Could not load ', fileName,':\' withCRs, ex description) = 2
ifTrue:[Processor activeProcess debug: ex signalerContext
title: ex description full: true].
ex return: nil.
].
island ifNotNil:[
"Ask the controller to update the router's time stamp"
p := controller routerStamp: (island get: #time).
p wait. "until the new time base is in effect"
].
].
].
island ifNotNil:[controller island: island].
island ifNil:[
"Create a new island"
island := controller newIsland. "Create a new island handled by the controller"
"the island must have the same id/name as the router to generate postcards"
island future id: id name: aString.
sync := island future new: islandClass.
self enableIslandCache ifTrue:[
sync wait.
"Make sure we don't interfere with render - render may hold a lock on the island which will not get released since this is the main thread being expected to signal readyToRender. Therefore we signal readyToRender right here to force it to render if a render operation was pending (if not, we fall right through this code)."
readyToRender signal.
readyToRender wait.
data := controller snapshot.
file := self cacheDirectory forceNewFileNamed: fileName.
file binary.
[file nextPutAll: data] ensure:[file close].
].
].
self updateEmbeddedAppsIn: island.
islandsByName at: aString put: island.
islandsByID at: id put: island.
^island! !
-
defaultErrorHandler
-
-
KStandardHarness {accessing}
-
defaultErrorHandler
^defaultErrorHandler! !
-
defaultErrorHandler:
-
-
KStandardHarness {accessing}
-
defaultErrorHandler: aSymbol
aSymbol = #resetRouter: ifTrue: [self startWatchdog] ifFalse: [self stopWatchdog].
defaultErrorHandler := aSymbol! !
-
defaultURL
-
-
KStandardHarness {accessing}
-
defaultURL
^DefaultURL ifNil: [DefaultURL := 'http://www.google.com' asUrl]! !
-
defaultURL:
-
-
KStandardHarness {accessing}
-
defaultURL: url
DefaultURL := url! !
-
destroy
-
-
CroquetHarness {initialize}
-
destroy
embeddedApps do:[:app| app destroy].
ogl ifNotNil:[ogl destroy].
ogl := nil.
controllers ifNotNil:[
controllers do:[:each| each destroy. ].
].
controllers := nil.
contactPoint ifNotNil:[contactPoint destroy].
dispatcher ifNotNil:[dispatcher destroy].! !
-
CroquetHarnessWithMenu {initialize}
-
destroy
autoSaveProcess ifNotNil: [autoSaveProcess terminate].
publishProcess ifNotNil: [publishProcess terminate].
propertiesFile storePropertiesInDefaultFile.
super destroy.! !
-
KStandardHarness {as yet unclassified}
-
destroy
self stopWatchdog.
super destroy.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
KStandardHarness class
instanceVariableNames: ''!
-
OpenALHarness {initialize}
-
destroy
"Reclassified to check before destroying."
openAL ifNotNil: [
openAL destroy.
openAL := nil.
].
super destroy.
-
dispatcher
-
-
CroquetHarness {accessing}
-
dispatcher
^dispatcher! !
-
dispatcher:
-
-
CroquetHarness {accessing}
-
dispatcher: aDispatcher
dispatcher := aDispatcher! !
-
doRender
-
-
CroquetHarness {render}
-
doRender
^ doRender.! !
-
dropFile:
-
-
CroquetHarness {event handling}
-
dropFile: aFile
"Handle a file dropped via the OS"
| form |
form := Form fromBinaryStream: aFile.
^self dropForm: form! !
-
KStandardHarness {event handling}
-
dropFile: aFile
^self new: KMedia from: aFile.
! !
-
dropForm:
-
-
CroquetHarness {event handling}
-
dropForm: aForm
"Drop aForm in front of the camera"
| space island txtr tform aPosition size mat wnd |
size := aForm extent * 0.01.
"Grab both space and island"
space := self activeSpace.
island := self activeIsland.
tform := island future new: TForm.
tform future initialize: nil form: aForm mipmap: true shrinkFit: true extension: nil.
txtr := island future new: TTexture.
txtr future initializeWithTForm: tform.
txtr future aspect: size y / size x asFloat.
txtr future extent: size.
mat := island future new: TMaterial.
mat future ambientColor: #(1 1 1 0.99) asFloatArray.
mat future diffuseColor: #(1 1 1 0.99) asFloatArray.
mat future emissiveColor: #(1 1 1 0.99) asFloatArray.
txtr future material: mat.
aPosition := avatar translation - (avatar lookAt * 10).
wnd := self makeWindow.
wnd future contents: txtr.
wnd future translation: aPosition.
wnd future rotationAroundY: avatar yaw.
space future addChild: wnd.
-
embeddedApps
-
-
CroquetHarness {embedded apps}
-
embeddedApps
^embeddedApps! !
-
embeddedApps:
-
-
CroquetHarness {embedded apps}
-
embeddedApps: aCollection
embeddedApps := aCollection! !
-
enableIslandCache
-
-
CroquetHarness {islands}
-
enableIslandCache
^enableIslandCache! !
-
enableIslandCache:
-
-
CroquetHarness {islands}
-
enableIslandCache: aBool
enableIslandCache := aBool.! !
-
endVoiceChat
-
-
OpenALHarness {voice chat}
-
endVoiceChat
(voiceRecorder notNil and: [self isRecording]) ifTrue: [voiceRecorder stopRecording].
self avatar replica future endVoiceChat: avatar replica.
-
event
-
-
CroquetHarnessWithMenu {accessing}
-
event
^event! !
-
eventPointer
-
-
CroquetHarness {accessing}
-
eventPointer
^ eventPointer.! !
-
CroquetHarnessWithMenu {accessing}
-
eventPointer
^eventPointer! !
-
findContactByPostcard:
-
-
CroquetHarness {islands}
-
findContactByPostcard: pc
| contact |
contactPoint ifNil:[contactPoint := TContactPoint new].
pc routerAddress ifNil:["indicates that this is a LAN contact"
"Grab most recent contact"
pc routerID ifNotNil:["first by ID"
contact := contactPoint contactsByID at: pc routerID ifAbsent:[nil].
].
contact ifNil:["then by name"
contact := contactPoint contactsByName at: pc routerName ifAbsent:[nil].
].
contact ifNil:[^nil]. "still waiting for a contact"
contact setupContact.
self addController: contact controller.
self addIsland: contact controller island postcard: pc.
^ contact controller island.
] ifNotNil:[
"go out and find the contact on the WAN"
].
^ nil.! !
-
CroquetHarnessWithMenu {islandJoinHacks}
-
findContactByPostcard: pc
| contact toks ba |
contactPoint ifNil:[contactPoint := TContactPoint new].
pc routerAddress ifNil:["indicates that this is a LAN contact"
"Grab most recent contact"
pc routerID ifNotNil:["first by ID"
contact := contactPoint contactsByID at: pc routerID ifAbsent:[nil].
].
contact ifNil:["then by name"
contact := contactPoint contactsByName at: pc routerName ifAbsent:[nil].
].
contact ifNil:[^nil]. "still waiting for a contact"
contact setupContact.
self addController: contact controller.
self addIsland: contact controller island postcard: pc.
^ contact controller island.
] ifNotNil:[
"go out and find the contact on the WAN"
Transcript show: '************ Doing the WAN connect **************';cr.
toks := pc routerAddress subStrings: ':.'.
ba := ByteArray new: 4.
1 to: 4 do: [:i | ba at: i put: (toks at: i) asInteger].
contact := TContact new
address: ba
port: (toks at: 5) asInteger
id: pc routerID
name: pc routerName.
contact setupContact.
self addController: contact controller.
self addIsland: contact controller island postcard: pc.
^ contact controller island.
].
^ nil.! !
-
KStandardHarness {islands}
-
findContactByPostcard: pc
| contact toks ba |
"This would more accurately be named findIslandByPostcardViaContact:"
self flag: #jcg.
contactPoint ifNil:[contactPoint := TContactPoint new].
pc routerAddress ifNil:["indicates that this is a LAN contact"
"Grab most recent contact"
pc routerID ifNotNil:["first by ID"
contact := contactPoint contactsByID at: pc routerID ifAbsent:[nil].
].
contact ifNil:["then by name"
contact := contactPoint contactsByName at: pc routerName ifAbsent:[nil].
].
contact ifNil:[^nil]. "still waiting for a contact"
] ifNotNil:[
"go out and find the contact on the WAN"
Transcript show: '************ Doing the WAN connect **************';cr.
toks := pc routerAddress subStrings: ':.'.
ba := ByteArray new: 4.
1 to: 4 do: [:i | ba at: i put: (toks at: i) asInteger].
contact := TContact new
address: ba
port: (toks at: 5) asInteger
id: pc routerID
name: pc routerName.
].
contact setupContact.
^ contact controller island "will be nil if not yet synced"
-
findController:
-
-
CroquetHarness {accessing}
-
findController: aBlock
"Find a controller matching the given block"
^controllers detect: aBlock ifNone:[nil].! !
-
findIslandByPostcard:
-
-
CroquetHarness {islands}
-
findIslandByPostcard: pc
| island |
island := islandsByID at: pc routerID ifAbsent:[nil].
island ifNil:[island := islandsByName at: pc routerName ifAbsent:[nil]].
^ island.! !
-
KStandardHarness {islands}
-
findIslandByPostcard: pc
| island |
island := self islandByID: pc routerID.
island ifNil:[island := self islandByName: pc routerName].
^ island.! !
-
findViewpointByPostcard:
-
-
CroquetHarness {islands}
-
findViewpointByPostcard: pc
| island rval |
"Find the island"
island := self findIslandByPostcard: pc.
island ifNil:["if not here, try to find it on the net"
postcard := pc copy.
^nil].
"Try to resolve by viewpoint ID"
pc viewpointID ifNotNil:[
rval := island send:[ :isl | isl lookup: pc viewpointID].
rval ifNotNil:[^rval asFarRef].
].
"Otherwise use viewpoint name"
rval := island send:[ :isl | isl at: pc viewpointName].
^ rval ifNotNil:[rval asFarRef].
-
KStandardHarness {islands}
-
findViewpointByPostcard: pc
| island rval |
"Find the island"
island := self findIslandByPostcard: pc.
island ifNil:["if not here, try to find it on the net"
island := self findContactByPostcard: pc.
island ifNil: [^ nil].
].
"Try to resolve by viewpoint ID"
pc viewpointID ifNotNil:[
rval := island send:[ :isl | isl lookup: pc viewpointID].
rval ifNotNil:[^rval asFarRef].
].
"Otherwise use viewpoint name"
rval := island send:[ :isl | isl at: pc viewpointName].
^ rval ifNotNil:[rval asFarRef].
-
formManager
-
-
CroquetHarness {accessing}
-
formManager
^formMgr! !
-
frameCache
-
-
KSDKHarness class {frame cache}
-
frameCache
^ FrameCache ifNil: [FrameCache := IdentityDictionary new]! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:51:37 pm'!
-
gotoSnapshot:
-
-
CroquetHarness {accessing}
-
gotoSnapshot: snap
| pc sp tfm vp |
pc := snap postcard.
pc ifNil:[
sp := snap space.
tfm := snap globalTransform.
] ifNotNil:[
vp := self findViewpointByPostcard: pc.
sp := (vp get: #root) ifNil:[^nil].
tfm := vp get: #globalMatrixOut.
].
avatar newTransform: tfm.
avatar newPostcard: (sp get: #postcard).! !
-
handleManager
-
-
KStandardHarness {accessing}
-
handleManager
^ handleManager! !
-
hud
-
-
KStandardHarness {accessing}
-
hud
^hud! !
-
hud:
-
-
KStandardHarness {accessing}
-
hud: aHUD
hud := aHUD! !
-
initialize
-
-
CroquetHarness class {class initialization}
-
initialize
"CroquetHarness initialize"
IslandArgumentCopier initialize.
Smalltalk addToShutDownList: self.! !
-
CroquetHarness {initialize}
-
initialize
| seed |
"Not really needed but a good thing to do for sanity checks and testing"
FileDirectory addCroquetMimeTypes.
"Make sure the current island's random is properly seeded"
seed := ByteArray new: 128.
(TCryptoRandom gatherEntropy: seed) ifFalse:[
"Raise a warning about the poor quality of entropy"
self inform: '
WARNING: SECURITY PROBLEM DETECTED!!
This platform (', Smalltalk platformName, ') appears to have no good source
of entropy available. Since this DRAMATICALLY lowers the
quality of encryption we recommend bugging the platform
maintainer to work with the Croquet team to fix this problem.
'.
].
Island default randomStream seedVector: seed.
formMgr := self initializeFormManager.
cacheMgr := formMgr cacheManager. "share it"
enableIslandCache := false.
controllers := OrderedCollection new.
islandsByName := Dictionary new.
islandsByID := Dictionary new.
doRender := false.
readyToRender := Semaphore new.
overlays := #().
eventPointer := TPointer new.
redButtonPressed := false.
yellowButtonPressed := false.
snapshots := OrderedCollection new.
userID := (TObjectID for: 'User').
event := CroquetEvent new.
event userID: userID.
allowControllerAliasing := false.
self initializeAvatar.
self setupLocal.
task := TTaskMain new.
task harness: self.
embeddedApps := Dictionary new.! !
-
CroquetHarnessWithMenu {initialize}
-
initialize
| value avatarType |
super initialize.
propertiesFile := CroquetProperties new.
propertiesFile initializeFromFile.
" This is a hack until a better way to combine our avatars is figured out. "
Smalltalk at: #TAvatarUserMotion ifPresent: [ :class |
avatar := TAvatarUserMotion new.
].
avatar ifNil: [
avatar := TAvatarUserMenu new.
].
avatar snapshots: snapshots.
avatarType := propertiesFile getPropertyValue: 'avatarType' ifAbsent:['avatar'].
value := propertiesFile getPropertyValue: 'avatar' ifAbsent: nil.
(avatarType = 'avatar')
ifTrue: "normal avatar"
[
(value = nil)
ifTrue:
[
propertiesFile addProperty: 'avatar' withValue: 'Content/Avatars/WhiteRabbit.mdl'.
value := 'Content/Avatars/WhiteRabbit.mdl'.
].
avatar loadAvatar: value.
"avatar loadAvatar: 'Content/Avatars/WhiteRabbit.mdl'."
avatar harness: self.
].
"ifFalse:
[
avatarX := propertiesFile getPropertyValue: 'avatarX'.
avatarY := propertiesFile getPropertyValue: 'avatarY'.
avatarZ := propertiesFile getPropertyValue: 'avatarZ'.
avatarScale := propertiesFile getPropertyValue: 'avatarScale'.
objectFile := propertiesFile getPropertyValue: 'avatar'.
restFile := propertiesFile getPropertyValue: 'avatarIdleMotion'.
walkFile := propertiesFile getPropertyValue: 'avatarWalkMotion'.
translation := (avatarX @ avatarY @ avatarZ).
avatar harness: self.
self halt.
avatar loadAvatarWithRestMotion: restFile
withWalkMotion: walkFile
objFileName: objectFile
translation: translation
scale: avatarScale.
]."
avatar loadNickname: propertiesFile.
" Set the default gain for the listener. "
self listenerGain: 1.0.
-
KSDKHarness {initialize}
-
initialize
"CroquetHarness does a lot of stuff in initialize that we want to customize, but it doesn't
have the hooks we need for customization.
In this class, we have defined #initializeCroquetHarness the way we wish
CroquetHarness>>initialize was defined (with the right hooks).
Alas, we also depend on several subclasses of CroquetHarness, and their #initialize methods
do super initialize. But we can't allow that, or we'll loose the hooks!! Therefore, we
have to redefine each of their initialization methods, too.
Here we call each of these copied intialization methods in turn (only one has been altered),
without any (super) sends to the #initialize methods we are overriding."
self initializeCroquetHarness.
self initializeOpenALHarness.
self initializeCroquetHarnessWithMenu.! !
-
KStandardHarness {initialize}
-
initialize
| seed |
super initialize.
"Make sure that there is entropy in the ocean."
seed := ByteArray new: 128.
TCryptoRandom gatherEntropy: seed.
Island default randomStream seedVector: seed.
"We would prefer to not use a singleton here... see KClipboard class comment."
self flag: #jcg.
clipboard := KClipboard default.
clipboard harness: self.
handleManager := KTransientHandleManager new.
"Otherwise eg: window widget textures won't make it into global cache."
KSDKHarness clearFrameCache.
resetOnErrorDefault := false.! !
-
OpenALHarness {initialize}
-
initialize
super initialize.
[
openAL := OpenAL new.
openAL makeCurrent.
] ifError: [ :msg|
Transcript cr; show: 'Cannot start spatial sound: ', msg.
openAL := nil.
].
voiceChats := Dictionary new.! !
-
initializeAvatar
-
-
CroquetHarness {initialize}
-
initializeAvatar
avatar := TAvatarUser new.
avatar userID: userID.
avatar harness: self.
avatar snapshots: snapshots.
avatar loadAvatar: 'Content/Avatars/WhiteRabbit.mdl'.
-
initializeAvatar:
-
-
KSDKHarness {initialize}
-
initializeAvatar: mySnapshots
"Plain old harness stuff. NOTE: we don't really need 'mySnapshots' as an argument, since we can just refer to the 'snapshots' iVar."
" avatar := TAvatarUser new.
avatar userID: userID.
avatar harness: self.
avatar snapshots: mySnapshots.
avatar loadAvatar: 'Content/Avatars/WhiteRabbit.mdl'.
"
"motion avatar stuff"
| avatarType value |
propertiesFile := CroquetProperties new.
propertiesFile initializeFromFile.
" This is a hack until a better way to combine our avatars is figured out. "
Smalltalk at: #TAvatarUserMotion ifPresent: [ :class |
avatar := TAvatarUserMotion new.
].
avatar ifNil: [
avatar := TAvatarUserMenu new.
].
avatar snapshots: mySnapshots.
avatarType := propertiesFile getPropertyValue: 'avatarType' ifAbsent:['avatar'].
value := propertiesFile getPropertyValue: 'avatar' ifAbsent: nil.
(avatarType = 'avatar')
ifTrue: "normal avatar"
[
(value = nil)
ifTrue:
[
propertiesFile addProperty: 'avatar' withValue: 'Content/Avatars/WhiteRabbit.mdl'.
value := 'Content/Avatars/WhiteRabbit.mdl'.
].
avatar loadAvatar: value.
avatar harness: self.
].
avatar loadNickname: propertiesFile.
-
KStandardHarness {initialize}
-
initializeAvatar: mySnapshots
"NOTE: we don't really need 'mySnapshots' as an argument, since we can just refer to the 'snapshots' iVar."
avatar := KAvatarUser new.
avatar userID: userID.
avatar harness: self.
avatar snapshots: mySnapshots.
avatar loadAvatar: 'Content/Avatars/WhiteRabbit.mdl'.
-
initializeCroquetHarness
-
-
KSDKHarness {initialize}
-
initializeCroquetHarness
| seed |
"Not really needed but a good thing to do for sanity checks and testing"
FileDirectory addCroquetMimeTypes.
"Make sure the current island's random is properly seeded"
seed := ByteArray new: 128.
(TCryptoRandom gatherEntropy: seed) ifFalse:[
"Raise a warning about the poor quality of entropy"
self inform: '
WARNING: SECURITY PROBLEM DETECTED!!
This platform (', Smalltalk platformName, ') appears to have no good source
of entropy available. Since this DRAMATICALLY lowers the
quality of encryption we recommend bugging the platform
maintainer to work with the Croquet team to fix this problem.
'.
].
Island default randomStream seedVector: seed.
formMgr := self initializeFormManager.
cacheMgr := formMgr cacheManager. "share it"
enableIslandCache := false.
controllers := OrderedCollection new.
islandsByName := Dictionary new.
islandsByID := Dictionary new.
doRender := false.
readyToRender := Semaphore new.
overlays := #().
self initializePointer.
snapshots := OrderedCollection new.
userID := (TObjectID for: 'User').
self initializeEvent.
event userID: userID.
allowControllerAliasing := false.
self initializeAvatar: snapshots.
self setupLocal.
task := TTaskMain new.
task harness: self.
embeddedApps := Dictionary new.
-
initializeCroquetHarnessWithMenu
-
-
KSDKHarness {initialize}
-
initializeCroquetHarnessWithMenu
| |
propertiesFile := CroquetProperties new.
propertiesFile initializeFromFile.
"Removed motion avatar stuff for now. Besides, it belongs in initializeAvatar."
avatar loadNickname: propertiesFile.
" Set the default gain for the listener. "
self listenerGain: 1.0.
-
initializeEvent
-
-
KSDKHarness {initialize}
-
initializeEvent
event := KSDKEvent new.! !
-
initializeFormManager
-
-
CroquetHarness {initialize}
-
initializeFormManager
"Initialize the form manager. Subclasses may override this method to provide other form managers."
TFormManager default destroy.
TFormManager default: nil.
^TFormManager default.
-
KStandardHarness {initialize}
-
initializeFormManager
^self initializeResourceManagers. "a more appropriate name."
-
initializeOpenALHarness
-
-
KSDKHarness {initialize}
-
initializeOpenALHarness
[
openAL := OpenAL new.
openAL makeCurrent.
] ifError: [ :msg|
Transcript cr; show: 'Cannot start spatial sound: ', msg.
openAL := nil.
].
voiceChats := Dictionary new.! !
-
initializePointer
-
-
KSDKHarness {initialize}
-
initializePointer
eventPointer := KSDKPointer new.
redButtonPressed := false.
yellowButtonPressed := false.
-
initializeResourceManagers
-
-
KStandardHarness {initialize}
-
initializeResourceManagers
TFormManager default destroy.
TFormManager default: KSharedMediaCache new..
^TFormManager default.
-
isRecording
-
-
OpenALHarness {testing}
-
isRecording
^ voiceRecorder notNil and: [ voiceRecorder isRecording ].! !
-
islandByID:
-
-
KStandardHarness {private-islands}
-
islandByID: id
| controller |
controller := islandsByID at: id ifAbsent: [^ nil].
^ controller island! !
-
islandByName:
-
-
KStandardHarness {private-islands}
-
islandByName: name
| controller |
controller := islandsByName at: name ifAbsent: [^ nil].
^ controller island! !
-
keyDown:
-
-
CroquetHarness {event handling}
-
keyDown: anEvent
event timeStamp: anEvent timeStamp.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event shiftPressed: anEvent shiftPressed.
event controlKeyPressed: anEvent controlKeyPressed.
event selection: eventPointer selection.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyDown: event)ifTrue:[ ^ self. ].
].
avatar keyDown: event. ! !
-
KSDKHarness {event handling}
-
keyDown: anEvent
event timeStamp: anEvent timeStamp.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event shiftPressed: anEvent shiftPressed.
event controlKeyPressed: anEvent controlKeyPressed.
event selection: eventPointer selection.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyDown: event)ifTrue:[ ^ self. ].
"Exit here, too if on foreign island. See http://bugs.impara.de/view.php?id=5717"
eventPointer selectedTarget island = avatar replica island ifFalse:[^self].
].
avatar keyDown: event. ! !
-
KStandardHarness {event handling}
-
keyDown: anEvent
"We sometimes get problems when we're in a transition to a different space."
avatar replica ifNil: [^ self].
avatar safeTranslation. "for effect"
super keyDown: anEvent.! !
-
keyStroke:
-
-
CroquetHarness {event handling}
-
keyStroke: anEvent
| controlWasPressed shiftWasPressed |
"XXXX: FIXME: Use the control and shift key bit from the last event to make
scroll wheel events work correctly with those keys."
shiftWasPressed := event shiftPressed.
controlWasPressed := event controlKeyPressed.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event selection: eventPointer selection.
event controlKeyPressed: controlWasPressed.
event shiftPressed: shiftWasPressed.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyStroke: event)ifTrue:[^ self.].
].
avatar keyStroke: event. ! !
-
KSDKHarness {event handling}
-
keyStroke: anEvent
| controlWasPressed shiftWasPressed |
"XXXX: FIXME: Use the control and shift key bit from the last event to make
scroll wheel events work correctly with those keys."
shiftWasPressed := event shiftPressed.
controlWasPressed := event controlKeyPressed.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event selection: eventPointer selection.
event controlKeyPressed: controlWasPressed.
event shiftPressed: shiftWasPressed.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyStroke: event)ifTrue:[^ self.].
"Exit here, too if on foreign island. See http://bugs.impara.de/view.php?id=5717"
eventPointer selectedTarget island = avatar replica island ifFalse:[^self].
].
avatar keyStroke: event.
! !
-
KStandardHarness {event handling}
-
keyStroke: anEvent
"We sometimes get problems when we're in a transition to a different space."
avatar replica ifNil: [^ self].
avatar safeTranslation. "for effect"
super keyStroke: anEvent.! !
-
keyUp:
-
-
CroquetHarness {event handling}
-
keyUp: anEvent
event timeStamp: anEvent timeStamp.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event shiftPressed: anEvent shiftPressed.
event controlKeyPressed: anEvent controlKeyPressed.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyUp: event) ifTrue:[ ^ self. ].
].
avatar keyUp: event.
! !
-
KSDKHarness {event handling}
-
keyUp: anEvent
event timeStamp: anEvent timeStamp.
event buttons: anEvent buttons.
event keyValue: anEvent keyValue.
event avatar: avatar replica.
event shiftPressed: anEvent shiftPressed.
event controlKeyPressed: anEvent controlKeyPressed.
"if we are pointing to something then send the event to that, otherwise send to avatar"
eventPointer selectedTarget ifNotNil:[
(task doKeyUp: event) ifTrue:[ ^ self. ].
"Exit here, too if on foreign island. See http://bugs.impara.de/view.php?id=5717"
eventPointer selectedTarget island = avatar replica island ifFalse:[^self].
].
avatar keyUp: event.
! !
-
KStandardHarness {event handling}
-
keyUp: anEvent
"We sometimes get problems when we're in a transition to a different space."
avatar replica ifNil: [^ self].
avatar safeTranslation. "for effect"
super keyUp: anEvent.! !
-
listenerGain
-
-
CroquetHarnessWithMenu {accessing}
-
listenerGain
^listenerGain! !
-
OpenALHarness {accessing}
-
listenerGain
^ 1.0! !
-
listenerGain:
-
-
CroquetHarnessWithMenu {accessing}
-
listenerGain: aFloat
listenerGain := aFloat.
-
loadFrame: orCreate:
-
-
CroquetHarness {initialize}
-
loadFrame: fileName orCreate: aClass
"Try to load the dungeon from cache"
| file island portal reader info label bar |
info := 'Loading ', fileName.
label := StringMorph new contents: info.
" self addMorphFront: label."
" label position: self position."
bar := [:aString| label contents: aString. World doOneCycleNow].
file := [FileStream readOnlyFileNamed: fileName]
on: FileDoesNotExistException
do:[:ex| ex return: nil].
file ifNotNil:[
[
reader := TIslandReader new.
reader progressBar: bar.
reader defaultInfo: info.
island := [reader readObjectFrom: file]
on: Error do:[:ex| ex return: nil].
island ifNotNil:[
portal := island portal.
].
] ensure:[file close].
].
portal ifNil:["no cached version - recreate from scratch"
island := TIsland new.
island scheduler: (island new: ScriptScheduler).
island name: aClass name.
portal := island new: aClass.
island portal: portal.
file := FileStream forceNewFileNamed: fileName.
[
self saveIsland: island on: file.
] ensure:[
file close.
].
].
label delete.
^portal.! !
-
logAllWorlds
-
-
KStandardHarness {messages}
-
logAllWorlds
islandsByName keysAndValuesDo: [:name :controller |
controller log: (self logDirectory forceNewFileNamed: name, '.log').
].! !
-
logDirectory
-
-
KStandardHarness {accessing}
-
logDirectory
| fd |
fd := FileDirectory default directoryNamed: 'controller-logs'.
fd assureExistence.
^fd! !
-
makeAudioSource
-
-
KStandardHarness {actions}
-
makeAudioSource
| island speaker audioSource stream streamingSpeaker|
island := self activeIsland.
"Create speaker."
stream := FileStream readOnlyFileNamed:
(FileDirectory default pathFromURI: 'Content/Widgets/speaker.ASE').
speaker := KMediaMesh newOn: island from: stream.
stream close.
streamingSpeaker := KMediaStreamingSpeaker newOn: island from: speaker.
"Connect speaker to audio source."
audioSource := KLiveAudioSource current.
streamingSpeaker future audioID: audioSource sourceID.
"Add speaker to avatar."
streamingSpeaker future addRotationAroundY: 180.
streamingSpeaker future translation: -0.75@-0.75@1.
self addToAvatarOrSpace: streamingSpeaker.
^ streamingSpeaker! !
-
makeCube
-
-
KStandardHarness {actions}
-
makeCube
| cube |
cube := TCube newOn: self activeIsland.
^self new: KMedia3DContainer from: cube.! !
-
makeDesktop:
-
-
KStandardHarness {actions}
-
makeDesktop: url
| rfb |
rfb := KRFB newOn: self activeIsland.
rfb future initializeWithURI: url asString extent: 800@600.
^self windowFrom: rfb.
-
makeFloor: fileName:
-
-
KStandardHarness {actions}
-
makeFloor: sp fileName: txtrName
| floor txt isl |
txt := TTexture
new initializeWithFileName: txtrName
mipmap: true
shrinkFit: false.
txt uvScale: 8.0@8.0.
isl := self activeIsland.
floor := TCube newOn: isl.
floor future extentX:100 y:0.5 z: 100.
floor future translationX: 0 y: -6.0 z: 0.0.
floor future texture: txt.
floor future objectName: 'floor' copy.
floor := KMedia3DContainer newOn: isl from: floor.
sp future addChild: floor.
^ floor.
-
makeLight
-
-
KStandardHarness {actions}
-
makeLight
| obj |
obj := self makeNakedLight.
obj future visible: true.
obj future rotationAroundZ: 180.
^self new: KMedia3DContainer from: obj.! !
-
makeLight:
-
-
KStandardHarness {actions}
-
makeLight: sp
| tframe |
tframe := self makeNakedLight.
tframe future translationX: -10 y:0.0 z: 0.0.
tframe future rotationAroundZ: 120.
sp future addChild: tframe.
^tframe.! !
-
makeMirror
-
-
KStandardHarness {actions}
-
makeMirror
| portal |
portal := self activeIsland future new: TPortal.
^self windowFrom: portal.! !
-
makeNakedLight
-
-
KStandardHarness {actions}
-
makeNakedLight
| island tframe |
island := self activeIsland.
tframe := TLight newOn: island.
"This is to avoid some odd lighting effects"
tframe future rotateBy: 1 around: 1@0@0.
^tframe.! !
-
makeOpenALCurrent
-
-
OpenALHarness {openAL}
-
makeOpenALCurrent
openAL ifNil: [
^ self
].
openAL currentContext ifNotNil: [
openAL alListenerf: ALGain with: 0.0. "Mute the old context."
].
openAL makeCurrent.
openAL alListenerf: ALGain with: self listenerGain.
"We've been ignoring updates to the avatar's transform."
avatar replica future transformChanged.! !
-
makePortal
-
-
KStandardHarness {actions}
-
makePortal
| window place |
window := self makeMirror.
place := TGroup newOn: self activeIsland.
self activeSpace future addChild: place byUser: self avatar replica.
window future contents future postcardLink: place future postcard.
^window.! !
-
makeRFB: address: port:
-
-
KStandardHarness {actions}
-
makeRFB: passwordString address: addressString port: port
| rfb |
rfb := self activeIsland future new: KRFB.
rfb future name: #TMorphicWorld
extent: 800@600
data: { #makeRFB:address:port:. passwordString. addressString. port }.
^self windowFrom: rfb.
-
makeSnapshot
-
-
CroquetHarness {accessing}
-
makeSnapshot
"Make a snapshot at the current location."
^self makeSnapshot: self activeSpace angle: avatar yaw translation: avatar translation! !
-
makeSnapshot: angle: translation:
-
-
CroquetHarness {accessing}
-
makeSnapshot: space angle: yval translation: t
| trans snapshot |
trans := Matrix4x4 identity.
trans rotationAroundY: yval.
trans translation: t.
snapshot := TSnapshot new space: space transform: trans.
snapshots add: snapshot.! !
-
makeSpace
-
-
KStandardHarness {actions}
-
makeSpace
| island space name pc newWindow activeSpaceWindow portalToNewSpace portalToActiveSpace|
island := self activeIsland.
space := island future new: TSpace.
name := TObjectID new asSymbol.
space future registerGlobal: name.
self makeLight: space.
self makeFloor: space fileName: (FileDirectory uri: 'Content/Textures/') fileNames atRandom.
portalToActiveSpace := KMagneticPortal newOn: island.
newWindow := KMedia2DContainer newOn: island from: portalToActiveSpace.
newWindow future addRotationAroundY: 180.
space future addChild: newWindow.
portalToNewSpace := KMagneticPortal newOn: island.
activeSpaceWindow := self windowFrom: portalToNewSpace.
pc := portalToNewSpace future postcard.
portalToActiveSpace future postcardLink: pc.
pc := portalToActiveSpace future postcard.
portalToNewSpace future postcardLink: pc.
^activeSpaceWindow.
-
makeSphere
-
-
KStandardHarness {actions}
-
makeSphere
| sphere |
sphere := TSphere newOn: self activeIsland.
^self new: KMedia3DContainer from: sphere.! !
-
makeTestThingie
-
-
KStandardHarness {actions}
-
makeTestThingie
| thingie |
thingie := self activeIsland future new: TEmbeddedApp.
"thingie future name: #TMorphicWorld
extent: 400@300
data: { #makeMovie:. 'Content/Movies/CASTLE.mpg' }."
thingie future name: #TSlideShowApp extent: 400@300 data: 'icons'.
^self windowFrom: thingie.! !
-
makeText:
-
-
KStandardHarness {actions}
-
makeText: aString
| app |
app := self activeIsland future new: KMediaText.
app future initializeWithText:aString.
^ self windowFrom: app! !
-
makeVideoWindow
-
-
KStandardHarness {actions}
-
makeVideoWindow
| island videoWindow videoSource |
island := self activeIsland.
"Create video window."
videoWindow := KLiveVideoWindow newOn: island.
"Connect video window to video source."
videoSource := KLiveVideoSource current.
videoWindow future cameraID: videoSource sourceID.
"Add video window to avatar."
videoWindow future addRotationAroundY: 180.
videoWindow future translation: 0@3.7@1.9.
self addToAvatarOrSpace: videoWindow.
^ videoWindow! !
-
makeWindow
-
-
CroquetHarness {messages}
-
makeWindow
windowData ifNil:[windowData := TIslandCopier new export: TWindow new].
^TIslandCopier new import: windowData to: self activeSpace island.! !
-
mediaCache
-
-
KCacheHarness {accessing}
-
mediaCache
self flag: #jcg. "should rename iVar to 'mediaCache'"
^ formMgr! !
-
mediaCache:
-
-
KCacheHarness {accessing}
-
mediaCache: aSharedMediaCache
self flag: #jcg. "should rename iVar to 'mediaCache'"
formMgr := aSharedMediaCache! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:51:44 pm'!
-
mouseDown:
-
-
CroquetHarness {event handling}
-
mouseDown: evt
event timeStamp: evt timeStamp.
event shiftPressed: evt shiftPressed.
event controlKeyPressed: evt controlKeyPressed.
" test for moving "
(evt controlKeyPressed not and:[evt yellowButtonChanged]) ifTrue:[
yellowButtonPressed := true.
avatar mouseDown: evt.
].
" test for object selection "
evt redButtonChanged ifTrue:[
avatar updateCamera: ogl camera.
lastCameraTransform:= ogl camera globalTransform copy.
redButtonPressed := true.
eventPointer pointerDown: true.
self pointerXY: evt position.
event buttons: evt buttons.
event keyValue: 0.
event avatar: avatar replica.
event camera: ogl camera.
event selection: eventPointer selection.
task doPointerDown: event.
].
-
CroquetHarnessWithMenu {event handling}
-
mouseDown: evt
super mouseDown: evt.
" Signal a blue-button mouse event. "
evt blueButtonChanged ifTrue: [
event selection: eventPointer currentSelection.
blueButtonPressed := true.
avatar doBlueButtonDown: event.
].
-
KSDKHarness {event handling}
-
mouseDown: evt
ogl ifNil:[^self]. "happens during startup. See CroquetHarness>>pointerXY:."
super mouseDown: evt.! !
-
mouseMove:
-
-
CroquetHarness {event handling}
-
mouseMove: evt
| newCameraTransform |
self pointerXY: evt position.
event timeStamp: evt timeStamp.
event shiftPressed: evt shiftPressed.
event controlKeyPressed: evt controlKeyPressed.
yellowButtonPressed ifTrue:[
avatar mouseMove: evt.
].
redButtonPressed ifTrue:[
eventPointer pointerDown ifTrue: [
avatar updateCamera: ogl camera.
newCameraTransform := ogl camera globalTransform copy.
eventPointer selectedRayTransform: eventPointer localTransform.
eventPointer isOverlay ifFalse:[
eventPointer selectedCameraTransform ifNotNil:[
eventPointer selectedCameraTransform: lastCameraTransform orthoNormInverse * newCameraTransform * eventPointer selectedCameraTransform.
]
].
lastCameraTransform := newCameraTransform.
" eventPointer selectedCameraTransform: ogl camera globalTransform copy."
avatar laserControl: eventPointer redButton: redButtonPressed.
event buttons: evt buttons.
event shiftPressed: evt shiftPressed.
event keyValue: 0.
event camera: ogl camera.
event avatar: avatar replica.
event selection: eventPointer selection.
task doPointerMove: event.
].
].! !
-
KSDKHarness {event handling}
-
mouseMove: evt
ogl ifNil:[^self]. "happens during startup. See CroquetHarness>>pointerXY:."
super mouseMove: evt.! !
-
mouseUp:
-
-
CroquetHarness {event handling}
-
mouseUp: evt
event timeStamp: evt timeStamp.
event shiftPressed: evt shiftPressed.
event controlKeyPressed: evt controlKeyPressed.
evt yellowButtonChanged ifTrue:[
yellowButtonPressed := false.
avatar mouseUp: evt.
].
evt redButtonChanged ifTrue:[
eventPointer pointerDown ifTrue:[
eventPointer pointerDown: false.
(eventPointer selectedEventMask anyMask:TFrame eventPointerDown) ifTrue:[
avatar laserControl: eventPointer redButton: false.
event buttons: evt buttons.
event shiftPressed: evt shiftPressed.
event keyValue: 0.
event avatar: avatar replica.
event selection: eventPointer selection.
event camera: ogl camera.
task doPointerUp: event.
"after a #doPointerUp: we sent a #doPointerLeave: and force a pointer reset. This allows others to grab the object"
task doPointerLeave: event.
eventPointer resetTotal.
].
].
redButtonPressed := false.
].
-
CroquetHarnessWithMenu {event handling}
-
mouseUp: evt
" Signal a blue-button mouse event. "
evt blueButtonChanged ifTrue: [
avatar doBlueButtonUp: event.
blueButtonPressed := false.
eventPointer resetTotal.
].
super mouseUp: evt.
-
KSDKHarness {event handling}
-
mouseUp: evt
ogl ifNil:[^self]. "happens during startup. See CroquetHarness>>pointerXY:."
super mouseUp: evt.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
KSDKHarness class
instanceVariableNames: ''!
-
myEventMap
-
-
CroquetHarness {private}
-
myEventMap
^myEventMap! !
-
myEventMap:
-
-
CroquetHarness {private}
-
myEventMap: aMap
myEventMap := aMap! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
CroquetHarness class
instanceVariableNames: ''!
-
new: from:
-
-
KStandardHarness {actions}
-
new: aClass from: newObject
| container |
container := aClass newOn: self activeIsland from: newObject.
container ifNotNil: [
self activeSpace future addChild: container byUser: self avatar replica.
nil. "Don't put future in tail position."
].
^container.! !
-
ogl
-
-
CroquetHarness {accessing}
-
ogl
^ogl! !
-
openAL
-
-
OpenALHarness {accessing}
-
openAL
^ openAL! !
-
overlays
-
-
CroquetHarnessWithMenu {accessing}
-
overlays
^overlays! !
-
password
-
-
KStandardHarness {accessing}
-
password
^ password! !
-
password:
-
-
KStandardHarness {accessing}
-
password: passwordString
password := passwordString! !
-
pointerXY:
-
-
CroquetHarness {event handling}
-
pointerXY: pxy
ogl ifNil:[^self].
eventPointer localTransform: (ogl camera pointerXY: pxy).
avatar speedControl: (bounds center - pxy) / (bounds extent * 0.5)
pointer: eventPointer redButton: redButtonPressed.
-
popTask
-
-
CroquetHarness {accessing}
-
popTask
task := taskStack removeLast.
-
postcard
-
-
CroquetHarnessWithMenu {islandJoinHacks}
-
postcard
^postcard.! !
-
promptForStream
-
-
KStandardHarness {actions}
-
promptForStream
| dialog nameString |
^self ifTweak: [
dialog := CFileOpenDialog new.
nameString := dialog openFile: {
{'Pictures'. #('*.jpg' '*.bmp' '*.gif' '*.png' '*.tif' '*.jpeg')}.
{'Meshes'. #('*.ase' '*.wrl' '*.vrml' '*.mdl' '*.tea')}.
{'Audio'. #('*.mp3' '*.wav' '*.aif')}.
{'Video'. #('*.mpeg')}.
{'Flash'. #('*.swf')}.
{'Web'. #('*.html' '*.htm')}.
{'any'. #('*.*')}.
}
label: 'Choose content to import:'.
nameString ifNotNil: [FileDirectory default readOnlyFileNamed: nameString.].
]
ifNot: [self notYetImplemented. "self promptForURL etc."]! !
-
promptForURL
-
-
KStandardHarness {actions}
-
promptForURL
| nameString |
nameString := UIManager default request: 'URL to import:' initialAnswer: self defaultURL asString.
(nameString isNil or: [nameString isEmpty]) "Tweak returns nil, Morphic empty string."
ifTrue: [self defaultURL: nil] "A quick way to reset to default."
ifFalse: [self defaultURL: (self defaultURL newFromRelativeText: nameString)].
^self defaultURL.! !
-
propertiesFile
-
-
CroquetHarnessWithMenu {accessing}
-
propertiesFile
^ propertiesFile! !
-
publishSpaceNamed: description:
-
-
CroquetHarnessWithMenu {islands}
-
publishSpaceNamed: spName description: desc
| url args result aContact contactXml form byteStream foo writer |
aContact := TTeleportUtilities getContactInfo.
contactXml := TTeleportUtilities contactAsXml: aContact.
url := 'http://earth.software.umn.edu/cgi-bin/Publish'.
args := Dictionary new.
spName ifNotNil: [
args at: 'name' put: {spName}
].
desc ifNotNil:[
args at: 'description' put: {desc}
].
args at: 'postcard' put: {contactXml}.
args at: 'id' put: {aContact id asString}.
form := self ogl screenShot.
byteStream := RWBinaryOrTextStream on: (ByteArray new: 1000).
writer :=JPEGReadWriter2 on: byteStream.
Cursor write showWhile: [
writer nextPutImage: form quality: -1 progressiveJPEG: true].
writer close.
foo := Base64MimeConverter mimeEncode: byteStream.
args at: 'screenshot' put: {foo contents}.
result := HTTPClient httpPostMultipart: url args: args.
Transcript show: result content.
-
pushTask:
-
-
CroquetHarness {accessing}
-
pushTask: newTask
taskStack ifNil:[taskStack := OrderedCollection new.].
taskStack add: task.
task := newTask.! !
-
removeController:
-
-
CroquetHarness {accessing}
-
removeController: aController
controllers remove: aController ifAbsent:[].! !
-
removeVoiceChat:
-
-
OpenALHarness {voice chat}
-
removeVoiceChat: chatID
| chat |
openAL ifNil: [
^ nil
].
chat := voiceChats removeKey: chatID ifAbsent: [^ nil].
chat stop: openAL.
openAL nameManager delete: chat source.
^ chat! !
-
render
-
-
CroquetHarness {render}
-
render
doRender ifFalse:[^nil].
ogl ifNil:[^nil].
ogl forcePick: (ogl forcePick or:[task forcePick]).
renderProcess ifNotNil:[^readyToRender signal]. "avoid recursive calls"
readyToRender initSignals.
renderProcess := self fork: #renderProcess at: Processor activePriority+1.
readyToRender signal.
readyToRender waitTimeoutMSecs: 1000. "at most one sec"
ogl forcePick: false.
-
renderProcess
-
-
CroquetHarness {render}
-
renderProcess
doRender ifFalse:[
readyToRender signal.
^renderProcess := nil.
].
[self renderWorld] ensure:[
readyToRender signal.
renderProcess := nil.
].! !
-
renderSnapshot:
-
-
CroquetHarness {render}
-
renderSnapshot: snapshot
"Update the snapshot"
| delta sp pc tfm vp |
pc := snapshot postcard.
pc ifNil:[
sp := snapshot space.
sp isResolved ifFalse:[^nil]. "don't even try"
tfm := snapshot globalTransform.
] ifNotNil:[
vp := self findViewpointByPostcard: pc.
vp isResolved ifFalse:[^nil].
sp := (vp get: #root) ifNil:[^nil].
tfm := vp get: #globalMatrixOut.
].
ogl camera: TCamera new.
ogl camera bounds: snapshot bounds.
ogl camera initFrustum: ogl.
ogl camera localTransform: tfm.
sp renderView: ogl overlay: #().
ogl camera killFrame: true.
delta := bounds height - snapshot bounds height.
snapshot form: (ogl screenShot: (ogl camera bounds translateBy: 0 @ delta)).! !
-
renderWorld
-
-
CroquetHarness {render}
-
renderWorld
| mutexSet oldCam randomList |
avatar newPostcard ifNil:[
"@@@@ FIXME: This is screwed up - we should really know which space we're in @@@@"
avatar currentSpace == self activeSpace
ifFalse:[
avatar addToNewSpace: self activeSpace.
avatar updateCamera: ogl camera.
].
] ifNotNil:[
avatar addToNewSpace: (avatar newPostcard resolveViewpoint:ogl).
"@@@@ FIXME: This is screwed up, too - the following should use a proper future send not an immediate #send:. @@@@"
viewPortal send:[ :vp | vp postcardLink: avatar newPostcard.].
avatar newPostcard:nil.
avatar updateCamera: ogl camera.
" ogl camera localTransform: avatar globalTransform."
].
"We use activeSpace (the instance variable) only as memory
to detect space transitions. If activeSpace has changed, signal the event."
(activeSpace ~= self activeSpace) ifTrue: [
activeSpace := self activeSpace.
self signal: #activeSpaceChanged with: activeSpace.
].
mutexSet := TMutexSet withAll: (controllers collect:[:cc| cc mutex]).
mutexSet critical:[
readyToRender wait.
"Temporarily, force any attempt to creat OIDs to fail"
randomList := (controllers select:[:cc| cc island notNil])
collect:[:cc| cc island -> (cc island get: #randomStream)].
randomList do:[:a| a key send:[:x| x randomStream: nil]].
ogl ifNotNil:[
formMgr updateList: ogl.
avatar updateCamera: ogl camera.
avatar driveStep.
self aboutToRender.
ogl makeCurrent.
ogl glLoadIdentity.
event avatar: avatar replica.
event camera: ogl camera.
eventPointer resetSelected: event.
ogl eventPointer: eventPointer.
(redButtonPressed and:[task noPickWhileDown])ifTrue:[
eventPointer selection target ifNotNil:[
eventPointer selectedRayTransform: eventPointer localTransform.
eventPointer selection target send:[ :tgt | tgt pickSelf: ogl .].
].
ogl eventPointer: nil.
].
viewPortal send:[ :vp | vp renderView: ogl with:{systemOverlayPortal}.].
overlays do:[:each| each renderOverlay: ogl].
ogl swapBuffers.
"render snapshots"
oldCam := ogl camera.
snapshots do:[:snap|
snap update ifTrue:[self renderSnapshot: snap]].
ogl camera: oldCam.
ogl camera initFrustum: ogl.
].
randomList do:[:a| a key send:[:x| x randomStream: a value]].
].
ogl eventPointer: eventPointer.
-
restoreIsland: named:
-
-
CroquetHarnessWithMenu {islands}
-
restoreIsland: islandData named: islandName
| islandID router controller island p entry pc |
islandID := TObjectID new.
"@@@@ FIXME: This is clearly not the way to do it @@@@"
router := TSimpleRouter new.
false ifTrue:[router log: Transcript].
router addUserName: 'foo' password: 'bar'.
dispatcher addRouter: router id: islandID.
self contactPoint addBroadcast:(TContact new
address: dispatcher address port: dispatcher port
id: islandID name: islandName).
"This is stupid but I need a controller instance below to #restore: the island"
controller := TSimpleController new.
island := [controller restore: islandData] on: Error do:[:ex| Transcript show: ex. ex return: nil].
island ifNotNil:[
"@@@@ FIXME: How do we tell a router what its current time is? @@@@"
router timeStamp: (island get: #time).
controller connectTo: dispatcher address port: dispatcher port sessionID: islandID.
self addController: controller.
p := controller login: 'foo' password: 'bar'.
p wait. "not good style but easier for the setup"
p := controller join. "receive messages"
p wait. "see above"
controller heartbeat: 20.
controller beServer. "act as server"
controller backDoor: (dispatcher routers at: islandID).
controller island: island.
entry := island future at: #mainEntry.
pc := entry future postcard.
pc whenResolved:[
self addIsland: island postcard: pc value.
TTeleportUtilities makePortalToAnotherWorld: pc
value avatar: avatar
portalType: #twoway.
].
].
^ island
-
runWatchdog
-
-
KStandardHarness {messages}
-
runWatchdog
"Ask each controller to make sure they have an island. Only needed for headless, because otherwise #step takes care of it."
[true] whileTrue: [
controllers do:[:each| each island].
(Delay forMilliseconds: 5000) wait.
].! !
-
saveCurrentWorld
-
-
KStandardHarness {actions}
-
saveCurrentWorld
(self activeSpace island get: #controller) cacheTo: self cacheDirectory
archive: self archiveDirectory.
-
saveIsland: on:
-
-
CroquetHarness {islands}
-
saveIsland: island on: file
| writer |
writer := TIslandWriter new.
"Prepare the project for saving"
island portal signal: #shutDownIsland with: false.
island scheduler run.
"Checkpoint project"
Cursor wait showWhile:[
[writer snapshot: island] ensure:[
"Start the project again"
island project signal: #startUpProject with: false.
].
].
writer failed ifTrue:[^self inform: 'Checkpoint failed'].
Cursor write showWhile:[writer saveObjectOn: file].
island croquet: self.
-
saveParticipatingWorlds
-
-
KStandardHarness {actions}
-
saveParticipatingWorlds
| is |
islandsByID do: [:ctrl |
(is := ctrl island) ifNotNil: [
(is get: #name) ifNotNil: [ "e.g., for local controllers"
ctrl cacheTo: self cacheDirectory archive: self archiveDirectory
].
].
]
-
setupLocal
-
-
CroquetHarness {initialize}
-
setupLocal
| localController sop |
localController := TLocalController new.
localController join. "request messages"
localController heartbeat: 20.
self addController: localController.
systemIsland := localController newIsland.
"make a portal inside the local island"
viewPortal := systemIsland future new: TPortal.
systemIsland future at: #portal put: viewPortal.
"make system overlay inside the local island"
systemOverlay := systemIsland future new: TSystemSpace.
systemOverlayPortal := systemIsland future new: TPortal.
sop := systemOverlay future postcard.
sop whenResolved:[
systemOverlayPortal future postcardLink: sop value.
self addIsland: systemIsland postcard: sop value.
].
" island future at: #systemOverlay put: systemOverlay."
postcard := TPostcard new routerAddress: nil "don't know what it is"
id: nil "don't know what it is"
name: 'Master'
viewpointName: #masterSpace.
viewPortal future postcardLink: postcard.! !
-
setupMaster
-
-
CroquetHarness {initialize}
-
setupMaster
| space sync island portal spc pc rIsland rportal rpc portal3D rspace rspc |
island := self createIsland: SimpleWorld named: 'Master'.
space := island future at: #masterSpace.
portal := island future at:#portal1.
portal3D := island future at:#portal3D.
spc := space future postcard.
pc := portal future postcard.
spc whenResolved:[
self addIsland: island postcard: spc value.
sync := viewPortal future postcardLink: spc value.
sync whenResolved:[doRender := true]. "ready to render"
].
rIsland := self createIsland: RecurseWorld named: 'Recurse'.
rspace := rIsland future at: #recurseSpace.
rspc := rspace future postcard.
rportal := rIsland future at: #portal1.
rpc := rportal future postcard.
pc whenResolved:[
rpc whenResolved:[
self addIsland: rIsland postcard: rpc value.
portal future postcardLink: rpc value.
rportal future postcardLink: pc value.
].
].
rspc whenResolved:[
portal3D future postcardLink: rspc value.
].
-
setupUser: password: entry: address: port:
-
-
KStandardHarness {initialize}
-
setupUser: usernameString password: passwordString entry: entryPostcard address: routerAddress port: routerPort
| cacheController promise |
self userName: usernameString.
self avatar nickname: self userName.
self password: passwordString.
"Allow use of global cache. This isn't the prettiest."
self bitCache: KGlobalBitCache new.
self mediaCache bitCache: self bitCache.
cacheController := KCacheController new.
self bitCache controller: cacheController.
self addController: cacheController.
cacheController
connectTo: (NetNameResolver addressForName: routerAddress)
port: routerPort
sessionID: KCacheRouter defaultRouterID.
promise := cacheController login: 'global' password: 'cache'.
promise wait.
promise := cacheController join.
promise wait.
KCroquetParticipant worlds do:
[:class || contact |
contact := KContact new
address: (NetNameResolver addressForName: routerAddress)
port: routerPort
id: class islandID name: class name asString
worldClass: class
harness: self.
self addContact: contact].
self viewPortal future postcardLink: entryPostcard.
postcard := entryPostcard. "Now, the entry postcard is the only one we wait for."
self step. "why doesn't this happen when we openInWorld?"
-
setupUser: password: entryWorld: address: port:
-
-
KStandardHarness {initialize}
-
setupUser: username password: passwordString entryWorld: aClass address: routerAddress port: routerPort
| entry |
entry := (TPostcard new routerAddress: nil
id: aClass islandID name: aClass name asString
viewpointName: #mainEntry).
self setupUser: username password: passwordString entry: entry address: routerAddress port: routerPort.! !
-
shutDown:
-
-
CroquetHarness class {class initialization}
-
shutDown: quitting
TFormManager default destroy.
TFormManager default: nil.! !
CroquetHarness initialize!
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:51:46 pm'!
-
snapshots
-
-
CroquetHarness {accessing}
-
snapshots
^snapshots! !
-
snapshots:
-
-
CroquetHarness {accessing}
-
snapshots: aCollection
snapshots := aCollection.! !
-
startAutoSaving
-
-
CroquetHarnessWithMenu {islands}
-
startAutoSaving
| delay |
autoSaveProcess ifNil: [
delay := Delay forSeconds: 15. "15 minutes"
autoSaveProcess := [
[true] whileTrue: [
delay wait.
self checkpointActiveIsland.
].
] forkAt: Processor userSchedulingPriority + 1.
] ifNotNil: [
autoSaveProcess isSuspended ifTrue: [
autoSaveProcess resume.
].
].
! !
-
startPublishing
-
-
CroquetHarnessWithMenu {islands}
-
startPublishing
| delay |
publishProcess ifNil: [
delay := Delay forSeconds: 300. "5 minutes"
publishProcess := [
[true] whileTrue: [
delay wait.
self publishSpaceNamed:nil description:nil.
].
] forkAt: Processor userSchedulingPriority + 1.
] ifNotNil: [
publishProcess isSuspended ifTrue: [
publishProcess resume.
].
].
! !
-
startRender
-
-
CroquetHarness {render}
-
startRender
"Start rendering"
doRender := true.! !
-
startVoiceChat
-
-
OpenALHarness {voice chat}
-
startVoiceChat
self voiceRecorder streamer: avatar.
self voiceRecorder startRecording.
self avatar replica future startVoiceChat: avatar replica.
! !
-
startWatchdog
-
-
KStandardHarness {messages}
-
startWatchdog
self stopWatchdog.
watchdog := self fork: #runWatchdog at: Processor userSchedulingPriority + 1.! !
-
step
-
-
CroquetHarness {messages}
-
step
| island |
postcard ifNotNil:[
island := self findIslandByPostcard: postcard.
island ifNil:[island := self findContactByPostcard: postcard.].
island ifNotNil:[
postcard := nil.
doRender ifFalse:[self startRender].
].
].
"Yield the processor to the O.S. at least once per frame;
this allows background processes (e.g. Gecko) to get at least a few cycles."
ProcessorScheduler relinquishProcessorForMicroseconds:1000.
renderProcess ifNil:[
controllers do:[:each| each critical:[each processMessages]].
].
(Smalltalk platformName = 'Win32') ifTrue: [
ProcessorScheduler relinquishProcessorForMicroseconds: 1000.
].
formMgr step.
avatar updateUser.
-
KStandardHarness {messages}
-
step
| checkForSnapshot |
checkForSnapshot := postcard notNil.
super step.
"If islands are loading asynchronously, give them some time."
(controllers anySatisfy: [:c | c isSynced not]) ifTrue: [(Delay forMilliseconds: 20) wait].
"Is there a better place to add landmarks?
We can't add initial landmark during setup because the entry postcard isn't resolved that
early. #findViewpointByPostcard: returns nil in such cases, not a promise that we would
be able to hang a whenResolved: on."
(checkForSnapshot and: [postcard isNil]
and: [self activeSpace notNil] "I don't know how, but it happens")
ifTrue: [self addPotentialLandmark].! !
-
stopAutoSaving
-
-
CroquetHarnessWithMenu {islands}
-
stopAutoSaving
autoSaveProcess ifNotNil: [
autoSaveProcess terminate.
autoSaveProcess := nil.
]. ! !
-
stopRender
-
-
CroquetHarness {render}
-
stopRender
"Stop rendering"
doRender := false.! !
-
stopWatchdog
-
-
KStandardHarness {messages}
-
stopWatchdog
watchdog ifNotNil:[watchdog terminate].
watchdog := nil.! !
-
syncAllWorlds
-
-
KStandardHarness {actions}
-
syncAllWorlds
"Useful for starting up interactivity servers."
contactPoint contactsByID values do: [:c | c setupContact]! !
-
systemIsland
-
-
CroquetHarness {accessing}
-
systemIsland
^ systemIsland.! !
-
systemOverlay
-
-
CroquetHarness {accessing}
-
systemOverlay
^ systemOverlay.! !
-
updateCamera
-
-
CroquetHarness {accessing}
-
updateCamera
avatar updateCamera: ogl camera.
-
updateEmbeddedApp:
-
-
CroquetHarness {embedded apps}
-
updateEmbeddedApp: appRef
| appName appClass appID app |
appID := appRef get: #appID.
(self embeddedApps includesKey: appID) ifTrue:[^self]. "app already exists"
appName := appRef get: #appName.
appClass := TEmbeddedApp appNamed: appName.
Transcript cr; show: 'Instantiating new ', appName asString, ' (', appClass name, ')'.
appClass ifNotNil:[
app := appClass instantiateEmbeddedApp: appRef.
].
app ifNil:[
Transcript cr; show: 'WARNING: No app created for ', appName asString.
] ifNotNil:[
app userID: userID.
self embeddedApps at: appID put: app
].
-
updateEmbeddedAppsIn:
-
-
CroquetHarness {embedded apps}
-
updateEmbeddedAppsIn: anIsland
"Update the embedded apps in the given island"
| apps |
anIsland ifNil:[^nil].
"Transcript cr; show: 'Embedded app update request for ', anIsland."
apps := anIsland future at: #embeddedApps.
apps whenResolved:[
"Transcript cr; show: 'Embedded apps: ', apps value."
apps value ifNotNil:[apps value do:[:appRef| self updateEmbeddedApp: appRef]].
].
self runScript: #updateEmbeddedAppsIn: when:{anIsland. #updateEmbeddedApps}.! !
-
updateListenerPosition:
-
-
OpenALHarness {openAL}
-
updateListenerPosition: transform
| position orientation |
openAL ifNil: [
^ self
].
openAL isCurrent ifFalse: [ ^ self ]. "Ignore updates for now."
position := transform translation.
orientation := ((transform lookAt negated) asFloatArray, transform lookUp asFloatArray).
openAL alListener3f: ALPosition with: position x with: position y with: position z.
openAL alListenerfv: ALOrientation with: orientation.! !
-
userID
-
-
KStandardHarness {accessing}
-
userID
^ event userID! !
-
userName
-
-
KStandardHarness {accessing}
-
userName
^ userName! !
-
userName:
-
-
KStandardHarness {accessing}
-
userName: nameString
userName := nameString! !
-
viewPortal
-
-
CroquetHarness {accessing}
-
viewPortal
^viewPortal! !
-
voiceChats
-
-
OpenALHarness {accessing}
-
voiceChats
^ voiceChats! !
-
voiceRecorder
-
-
OpenALHarness {accessing}
-
voiceRecorder
^ voiceRecorder ifNil: [
voiceRecorder := TVoiceRecorder new samplingRate: 11025; recordLevel: 1 ].! !
-
windowFrom:
-
-
KStandardHarness {actions}
-
windowFrom: contents
^self new: KMedia2DContainer from: contents! !