-----------------------------------------------------------------------------
CroquetParticipant subclass: #BFDParticipant
instanceVariableNames: 'dock windowData'
classVariableNames: ''
poolDictionaries: ''
category: 'HedgeHacks-BFD'!
-----------------------------------------------------------------------------
!BFDParticipant commentStamp: '<historical>' prior: 0!
The participant for our big funding demo.!
-----------------------------------------------------------------------------
Morph subclass: #CroquetParticipant
instanceVariableNames: 'harness lastBounds'
classVariableNames: 'DefaultForm'
poolDictionaries: 'OpenGLConstants'
category: 'Croquet-Harness'!
-----------------------------------------------------------------------------
!CroquetParticipant commentStamp: 'das 4/22/2005 16:58' prior: 0!
CroquetMorph is currently the jumping off point for Croquet. We use Morphic to handle low-level events and communicate with Squeak. At some point, this dependency will change.
DAS!
-----------------------------------------------------------------------------
BFDParticipant subclass: #CroquetParticipantWithMenu
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MenuUI-Harness'!
-----------------------------------------------------------------------------
!CroquetParticipantWithMenu commentStamp: 'zamp 3/15/2006 09:12' prior: 0!
This adds the tweak menu bar overlay. It subclasses the main CroquetParticipant. It could be put into the main CroquetParticipant class in the future to make it less confusing. But, for now, it's easier to make development changes to it when it's in a different package.!
-----------------------------------------------------------------------------
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.!
-----------------------------------------------------------------------------
CroquetParticipantWithMenu subclass: #KCroquetParticipant
instanceVariableNames: 'entry address port nav'
classVariableNames: 'OldWindowButtonsClass RouterAddress RouterPort Worlds'
poolDictionaries: ''
category: 'Wisconsin-UI'!
-
addCustomMenuItems: hand:
-
-
CroquetParticipant {menu}
-
addCustomMenuItems: aMenu hand: aHand
super addCustomMenuItems: aMenu hand: aHand.
aMenu addUpdating: #showFrameRateString action: #toggleFrameRate.
aMenu add: 'toggle full screen' action: #toggleFullScreen.
-
addZoomNavigator
-
-
BFDParticipant {zoom navigator}
-
addZoomNavigator
dock := TZoomNavigatorMorph new.
dock position: self bounds bottomLeft.
dock fullBounds. "need the layout!!"
dock width: self width.
self addMorph: dock.
dock mouseLeave: nil.
dock addProjectRoot.
dock addSnapshotRoot.
dock addToolsRoot.
dock addAvatarRoot.
dock addTool: TPainter.
"dock addTool: TSpaceBrowser.
dock addTool: TConnectionDialog."! !
-
KCroquetParticipant {zoom navigator}
-
addZoomNavigator
"Mostly like superclass method, but not quite."
dock := KZoomNavigatorMorph new.
dock position: self bounds bottomLeft.
dock fullBounds. "need the layout!!"
dock width: self width.
self addMorph: dock.
dock mouseLeave: nil.
dock addSnapshotRoot.
dock addToolsRoot.
dock addAvatarRoot.
dock addTool: TPainter.
-
areasRemainingToFill:
-
-
CroquetParticipant {drawing}
-
areasRemainingToFill: aRectangle
^aRectangle areasOutside: self bounds! !
-
beginMorphicOverlay:
-
-
CroquetParticipant {Morphic render}
-
beginMorphicOverlay: ogl
"Set up gl to provide overlay drawing - this is done in pixel coordinates"
ogl glMatrixMode: GLProjection.
ogl glPushMatrix.
ogl glLoadIdentity.
ogl glMatrixMode: GLModelview.
ogl glPushMatrix.
ogl glLoadIdentity.
ogl glTranslated: -1 with: 1 with: 0.0.
ogl glScaled: (2.0 / bounds width) with: (-2.0 / bounds height) with: 1.0.
ogl glDisable: GLDepthTest.
ogl glEnable: GLBlend.
ogl glBlendFunc: GLOne with: GLOneMinusSrcAlpha.
-
clickOpenAliceFile:
-
-
BFDParticipant {3d sketch}
-
clickOpenAliceFile: filePath
| fName frame imported pos camera |
true ifTrue:[
^harness avatar loadAvatar: filePath.
].
"Import TFrame (non-replicated)"
fName := FileDirectory pathFromURI: filePath.
Cursor read showWhile:[
imported := TLoadMDL new parseFileNamed: fName.
].
"Copy resulting frame into island"
Cursor wait showWhile:[
| copier dstIsland conn |
dstIsland := harness activeIsland.
conn := (dstIsland send:[:x| x controller]) connection.
conn sendAmount: 0.
conn sendCount: 0.
copier := TIslandCopier new.
MessageTally spyOn:[frame := copier copy: imported to: dstIsland].
Transcript cr show: 'Messages sent: ', conn sendCount printString.
Transcript cr show: 'Data sent: ', conn sendAmount printString.
].
camera := harness camera.
pos := camera "avatar" translation - (camera "avatar" lookAt * 10).
frame future translation: pos.
harness activeSpace future addChild: frame.
-
clickProjectView:
-
-
BFDParticipant {zoom navigator}
-
clickProjectView: aProject
| fakeSHA morphic space island worldExtent txtr pos win |
aProject == Project current ifTrue:[^Smalltalk beep].
worldExtent := 1024@768.
space := harness activeSpace.
island := harness activeIsland.
fakeSHA := TFormManager generateSHA: (TObjectID for: 'Project SHA').
morphic := island future new: TMorphicForm.
morphic future
initialize: nil sha: fakeSHA
form: (Form extent: 32@32 depth: 32)
mipmap: false shrinkFit: true extension: nil.
morphic future bThumb: true.
morphic future worldExtent: worldExtent.
morphic future constructor: (MessageSend
receiver: MorphicWorldHost
selector: #makeProjectLink:extent:from:
argument: aProject name).
txtr := island future new: TTextureHackForm.
txtr future initializeWithTForm: morphic.
txtr future targetExtent: worldExtent.
win := self makeWindowIn: island.
win future contents: txtr.
"Position it"
pos := harness avatar translation - (harness avatar lookAt * 10).
win future translation: pos.
win future rotationAroundY: harness avatar yaw.
space future addChild: win.
-
collapse
-
-
CroquetParticipant {initialization}
-
collapse
-
createHarness
-
-
GridParticipant {as yet unclassified}
-
createHarness
^ GridHarness new! !
-
KCroquetParticipant {initialization}
-
createHarness
^ KStandardHarness new! !
-
defaultForm
-
-
CroquetParticipant class {as yet unclassified}
-
defaultForm
^DefaultForm ifNotNil:[DefaultForm] ifNil:[DefaultForm := Form extent: 64@64 depth: 32 bits: (Base64MimeConverter mimeDecode:
'8AAS/wAAAQf/AQEBFv8AAAEH/wABARL/AAABB/8BAAEK/wAAAQf/AAEBCv8AAAEH/wARAAr/
AAABE/8BAAD/AAEA/wAAAf8SAAAS/wAAAQf/AAEAEv8AAAEH/xEAAAr/AAABB/8BAAAO/wAA
ARv/AQAA/wAAAf8BAAH/AAAB/wEBAP8BAAAW/wAAAQf/AQABRv8AAAEP/wEAAP8AAAH/EhEQ
IgAK/xERETP/ADMz/wEAI/8AACH/ERAP/wAAIf8RERH/IiIh/wAAI/8hIiL/IiIi/xESEf8B
.
.
.
.
ADMK/xERESf/EBES/wAAM/8QERL/ACIA/wAAIf8BASP/EhES/xIREf8BADMO/yIiIif/ISIi
/yIiIv8hIiL/ATRm/yIiI/8AMzT/AQFF/yIiIv8ANDM=' as: String) asByteArray].! !
-
defaultRouterAddress
-
-
KCroquetParticipant class {accessing}
-
defaultRouterAddress
^ RouterAddress ifNil: [
KMessageRouter dispatcher
ifNotNil: [NetNameResolver localAddressString]
ifNil: [(UIManager default request:
'Enter interactivity server address, or leave blank to run your own locally.'
initialAnswer: 'www.croquetcollaborative.org')
ifEmpty: [KMessageRouter runRouters]
ifNotEmpty: [:x|x].
]
]! !
-
defaultRouterAddress:
-
-
KCroquetParticipant class {accessing}
-
defaultRouterAddress: addressString
RouterAddress := addressString! !
-
defaultRouterPort
-
-
KCroquetParticipant class {accessing}
-
defaultRouterPort
^ RouterPort ifNil: [5910]! !
-
defaultRouterPort:
-
-
KCroquetParticipant class {accessing}
-
defaultRouterPort: anInteger
RouterPort := anInteger! !
-
delete
-
-
BFDParticipant {initialization}
-
delete
TMorphicForm flushHosts.
super delete.! !
-
CroquetParticipant {initialization}
-
delete
harness ifNotNil:[harness destroy].
super delete.
-
CroquetParticipantWithMenu {destroying}
-
delete
super delete.
self tweakWorld
ifNil:[self scriptScheduler shutDown]
ifNotNil:[self shutdownTweakWorld].
-
descriptionForPartsBin
-
-
BFDParticipant class {as yet unclassified}
-
descriptionForPartsBin
^ self partName: 'Demo (Participant)'
categories: #('Croquet')
documentation: 'Croquet Demo Participant'
sampleImageForm: self defaultForm.! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:56:22 pm'!
-
CroquetParticipant class {as yet unclassified}
-
descriptionForPartsBin
^ self partName: 'Croquet(Participant)'
categories: #('Croquet')
documentation: 'Croquet Participant Browser - this uses someone else Croquet world'
sampleImageForm: self defaultForm.
-
GridParticipant class {parts bin}
-
descriptionForPartsBin
^ self partName: 'Grid Demo'
categories: #('Strick')
documentation: 'not yet'
sampleImageForm: self defaultForm.! !
'From Croquet1.0beta of 11 April 2006 [latest update: #0] on 24 March 2007 at 5:56:11 pm'!
-
KCroquetParticipant class {parts bin}
-
descriptionForPartsBin
^ self partName: 'KAT Demo'
categories: #('Croquet')
documentation: 'Introduction to WAN Croquet using KidsFirst Application Toolkit.'
sampleImageForm: self defaultForm.! !
-
drawOn:
-
-
CroquetParticipant {drawing}
-
drawOn: aCanvas
(harness == nil or:[harness doRender not]) ifTrue:["still waiting for connection"
super drawOn: aCanvas.
^aCanvas drawString: 'Waiting for connection...' at: bounds origin.
].
lastBounds ~= self bounds ifTrue:[
lastBounds := self bounds.
harness bounds: self bounds.
].
harness render.
Display addExtraRegion: bounds for: self.! !
-
KCroquetParticipant {drawing}
-
drawOn: aCanvas
"Ensure that we are on the default island (i.e. in the Ocean). We should always be, but there are some weird conditions (that should be fixed) that can cause this to not be the case. For example, writing to the Transcript causes an immediate Morphic world redraw, which can cause the participant to draw itself. It would be better to fix these conditions, but it is easier to patch it here."
self flag: #jcg. "Should fix the problem, not the symptom."
self island == Island default ifFalse: [^ self].
super drawOn: aCanvas.
-
drawSubmorphsOn:
-
-
CroquetParticipant {drawing}
-
drawSubmorphsOn: aCanvas
"ignore"! !
-
dropFiles:
-
-
CroquetParticipant {event handling}
-
dropFiles: anEvent
"Handle a number of dropped files from the OS."
| numFiles stream |
numFiles := anEvent contents.
1 to: numFiles do: [:i |
stream := FileStream requestDropStream: i.
[harness dropFile: stream] ensure:[stream close].
].! !
-
endMorphicOverlay:
-
-
CroquetParticipant {Morphic render}
-
endMorphicOverlay: ogl
"Set up gl to provide overlay drawing - this is done in pixel coordinates"
ogl glDisable: GLBlend.
ogl glMatrixMode: GLModelview.
ogl glPopMatrix.
ogl glMatrixMode: GLProjection.
ogl glPopMatrix.
ogl glMatrixMode: GLModelview.
-
entry
-
-
GridParticipant {as yet unclassified}
-
entry
^entry ifNil: [self entryWorld: GridWorld. entry].
-
KCroquetParticipant {accessing}
-
entry
^entry ifNil: [self entryWorld: WisconsinWorld. entry].
-
entry:
-
-
KCroquetParticipant {accessing}
-
entry: aPostcard
entry := aPostcard! !
-
entryWorld:
-
-
KCroquetParticipant {accessing}
-
entryWorld: aClass
self entry: (TPostcard new routerAddress: nil
id: aClass islandID name: aClass name asString
viewpointName: #mainEntry).! !
-
forceToScreen
-
-
CroquetParticipant {drawing}
-
forceToScreen
"Ignore. We handle buffer swaps in the renderer."
"Time millisecondClockValue printString displayAt: 0@0.
Display forceToScreen: (0@0 corner: 100@15)."! !
-
fpsMorph
-
-
CroquetParticipant {menu}
-
fpsMorph
^self valueOfProperty: #fpsMorph! !
-
fpsMorph:
-
-
CroquetParticipant {menu}
-
fpsMorph: aMorph
^self setProperty: #fpsMorph toValue: aMorph! !
-
glRenderMorphicOverlayOn:
-
-
CroquetParticipant {Morphic render}
-
glRenderMorphicOverlayOn: aRenderer
"Display submorphs back to front"
submorphs size = 0 ifTrue:[^self].
submorphs reverseDo:[:sm| sm glRenderOn: aRenderer].
-
glRenderStatsOn:
-
-
CroquetParticipantWithMenu {render}
-
glRenderStatsOn: ogl
| box locationY locationX |
(ogl glIsEnabled: GLLighting) "sanity check"
ifTrue:[self error: 'Lighting must be off!!!!!!'].
box := 0@0 extent: self extent.
locationY := box topRight y.
locationX := box topRight x.
self fpsMorph ifNotNil: [
self fpsMorph contents ifNotNil: [
ogl drawString: self fpsMorph contents
at: (locationX @ locationY @ 0)
font: nil
color: Color orange
align: #topRight.
locationY := locationY + 15.
].
].
self showPrimitiveStats ifTrue:[
ogl drawString:
ogl numVtx asStringWithCommas,' vtx / ',
ogl numPrims asStringWithCommas,' prims'
at: (locationX - 1 @ locationY @ 0)
font: nil
color: Color orange
align: #topRight.
locationY := locationY + 15.
].
harness voiceRecorder isRecording ifTrue: [
ogl drawString: harness voiceRecorder statusString
at: (locationX - 110)@10@0 font: nil color: Color orange align: #topLeft.
].
harness avatar recording ifTrue: [
ogl drawString: 'Recording'
at: (locationX - 110)@10@0 font: nil color: Color red align: #topLeft
].
harness avatar playback ifTrue: [
ogl drawString: 'Playback Running'
at: (locationX - 110)@10@0 font: nil color: Color red align: #topLeft
].
-
glRenderTweakCostume: on:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
glRenderTweakCostume: aCostume on: aRenderer
| box formCache texCache textureDict mat rectList bb tfm m44 tw th |
aCostume visible ifFalse:[^self].
textureDict := self tweakCache.
box := aCostume localFullBounds.
box := box origin asIntegerPoint corner: box corner asIntegerPoint.
formCache := aCostume localCache.
formCache ifNil:[aCostume localCache: (formCache := aCostume newFormCache)].
"figure out changes in size/depth"
(formCache form == nil
or:[formCache form extent isPowerOfTwo not
or:[formCache form extent asLargerPowerOfTwo ~= box extent asLargerPowerOfTwo]]) ifTrue:[
formCache form: (Form extent: box extent asLargerPowerOfTwo depth: 32).
].
"grab the texture cache"
texCache := textureDict at: aCostume ifAbsent:[nil].
"make sure it hasn't changed"
(texCache == nil or:[texCache textureForm ~~ formCache form]) ifTrue:[
texCache ifNotNil:[aRenderer releaseTexture: texCache tform].
texCache := TTexture new
initializeWithForm: formCache form
mipmap: false
shrinkFit: true.
mat := TMaterial new.
mat ambientColor: #(1.0 1.0 1.0 0.9) asFloatArray.
mat diffuseColor: #(1.0 1.0 1.0 0.9) asFloatArray.
mat emissiveColor: #(1.0 1.0 1.0 1.0) asFloatArray.
texCache material: mat.
" texCache isStatic: false."
textureDict at: aCostume put: texCache.
].
"repair damage"
rectList := formCache
repairDamage: aCostume localFullBounds
using:[:cc| aCostume localFullDrawOn: cc].
"fix up alpha and remember upload rectangle"
bb := BitBlt toForm: texCache textureForm.
bb combinationRule: 40 "fixAlpha:with:".
bb halftoneForm: (Bitmap with: 16rFF000000).
rectList do:[:r|
| aRect |
aRect := r translateBy: box origin negated.
bb destRect: aRect.
bb copyBits.
texCache invalidate: aRect.
].
"draw the costume"
texCache enable: aRenderer.
tfm := aCostume transform.
aRenderer glPushMatrix.
aRenderer glTranslatef: tfm offset x with: tfm offset y with: 0.0.
tfm isPureTranslation ifFalse:[
tfm := tfm asMatrixTransform2x3.
m44 := Matrix4x4 identity.
m44 a11: tfm a11; a12: tfm a21; a21: tfm a12; a22: tfm a22.
aRenderer glMultMatrixf: m44.
].
tw := box width asFloat / texCache textureForm width asFloat.
th := box height asFloat / texCache textureForm height asFloat.
aRenderer glBegin: GLQuads;
glTexCoord2f: 0.0 with: 0.0;
glVertex2f: box left with: box top;
glTexCoord2f: tw with: 0.0;
glVertex2f: box right with: box top;
glTexCoord2f: tw with: th;
glVertex2f: box right with: box bottom;
glTexCoord2f: 0.0 with: th;
glVertex2f: box left with: box bottom;
glEnd.
aRenderer glPopMatrix.
texCache disable: aRenderer.
-
glRenderTweakOn:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
glRenderTweakOn: ogl
| texCache textureDict myWorld |
(myWorld := self tweakWorld) ifNil:[^self].
(ogl glIsEnabled: GLLighting) "sanity check"
ifTrue:[self error: 'Lighting must be off!!!!!!'].
textureDict := self tweakCache.
ogl glColor4f: 1.0 with: 1.0 with: 1.0 with: 1.0.
self tweakWorld asPrimCostume do:[:aCostume|
self glRenderTweakCostume: aCostume on: ogl.
].
"self tweakWorld hands do:[:aHand|
aHand costume invalidationSuppressed
ifFalse:[self glRenderTweakCostume: aHand costume on: ogl].
]."
"remove obsolete costumes from texture dictionary"
textureDict keys "need a copy" do:[:aCostume|
aCostume container == myWorld costume ifFalse:[
"it got removed"
aCostume localCache: nil.
texCache := textureDict removeKey: aCostume.
ogl releaseTexture: texCache tform.
].
].! !
-
gotoSnapshot:
-
-
BFDParticipant {snapshots}
-
gotoSnapshot: snapMorph
harness gotoSnapshot: snapMorph snapshot! !
-
guestFacetNames
-
-
KCroquetParticipant class {accessing}
-
guestFacetNames
"Answer the names of the facets available to guests: those able to view but not affect the replicated simulation."
^ #(joinFacet
nil "sendFacet"
syncFacet
heartbeatFacet
nil "beServerFacet"
leaveFacet
requestContentFacet
beContentServerFacet
nil "setRouterTimeFacet"
requestCacheFacet
nil "resetFacet")! !
-
handleEvent:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
handleEvent: anEvent
| evt myWorld |
(anEvent isMouse and:[anEvent isMouseDown]) ifTrue:[self comeToFront].
(myWorld := self tweakWorld) ifNil:[^super handleEvent: anEvent].
(#(mouseDown mouseUp mouseMove
keyDown keyUp keystroke) includes: anEvent type) ifTrue:[
"pass it into myWorld"
evt := anEvent translatedBy: bounds origin negated.
"evt printString displayAt: 0@0."
myWorld eventQueue nextPut: evt clone.
anEvent wasHandled: true.
^true].
^super handleEvent: anEvent! !
-
handleMouseMove:
-
-
CroquetParticipant {event handling}
-
handleMouseMove: anEvent
"Reimplemented to get #mouseOver: messages"
self mouseOver: anEvent.
super handleMouseMove: anEvent.! !
-
handlesKeyboard:
-
-
CroquetParticipant {event handling}
-
handlesKeyboard: evt
^ true
-
handlesMouseDown:
-
-
CroquetParticipant {event handling}
-
handlesMouseDown: evt
^ true.
"evt yellowButtonPressed ifTrue: [^false] ifFalse: [^true]."
-
handlesMouseOver:
-
-
CroquetParticipant {event handling}
-
handlesMouseOver: evt
^ true.! !
-
handlesMouseStillDown:
-
-
CroquetParticipant {event handling}
-
handlesMouseStillDown: evt
^ true.! !
-
harness
-
-
CroquetParticipantWithMenu {accessing}
-
harness
^harness.! !
-
KCroquetParticipant {accessing}
-
harness
^harness! !
-
imageForm
-
-
CroquetParticipant {drawing}
-
imageForm
^harness ogl
ifNil: [super imageForm]
ifNotNil: [harness ogl screenShot]! !
-
initialize
-
-
BFDParticipant {initialization}
-
initialize
super initialize.
TZoomNavigatorMorph initialize. "check for new icons"
self extent: 600@400.
self addZoomNavigator.! !
-
CroquetParticipant {initialization}
-
initialize
super initialize.
self clipSubmorphs: true.
self color: (Color
r: 1.0
g: 0.0
b: 0.0).
self extent: 640@480.
self setProperty: #suppressStepping toValue: true.! !
-
CroquetParticipantWithMenu {initialization}
-
initialize
super initialize.
self removeMorph: dock.
self scriptScheduler: ScriptScheduler new.
self scriptScheduler runActiveScripts. "to get started"
self initializeTweakWorld.! !
-
GridParticipant {as yet unclassified}
-
initialize
"Add GridWorld if it is not already there"
(self class worlds includes: GridWorld) ifFalse: [
self class worlds: self class worlds, { GridWorld }
].
super initialize
-
initializeTweakWorld
-
-
CroquetParticipantWithMenu {tweak rendering}
-
initializeTweakWorld
self initializeTweakWorld: #CroquetMenuWorld.! !
-
KCroquetParticipant {tweak rendering}
-
initializeTweakWorld
self initializeTweakWorld: #KMenuWorld.! !
-
initializeTweakWorld:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
initializeTweakWorld: worldPlayer
self initializeTweakWorld: [ :aWorld | aWorld onBootstrap ] withWorldPlayer: worldPlayer.! !
-
initializeTweakWorld: withWorldPlayer:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
initializeTweakWorld: aBlock withWorldPlayer: wPlayer
"Make a Tweak overlay, and evaluate aBlock with the Tweak world to setup its contents. All events will go directly to the Tweak world, so register event handlers for us."
| myWorld |
myWorld := Smalltalk at: wPlayer ifPresent: [ :cls | cls basicNew ].
myWorld ifNil:[^self].
myWorld setScheduler: self scriptScheduler.
myWorld initialize.
myWorld ownerMorph: self.
myWorld eventQueue: SharedQueue new.
self tweakWorld: myWorld.
" Remove this evil hack. "
"PrivateIslands at: 'test' put: self island."
myWorld bootstrap: [
myWorld startScript: aBlock withArguments: {myWorld}.
self startScript: #onKeyDown: when:{myWorld. #keyDown}.
self startScript: #onKeyStroke: when:{myWorld. #keyStroke}.
self startScript: #onKeyUp: when:{myWorld. #keyUp}.
self startScript: #onMouseDown when:{myWorld. #mouseDown}.
self startScript: #onMouseMove when:{myWorld. #mouseMove}.
self startScript: #onMouseUp when:{myWorld. #mouseUp}.
self startScript: #onBlueButtonDown when:{myWorld. #blueButtonDown}.
self startScript: #onBlueButtonUp when:{myWorld. #blueButtonUp}.
self startScript: #onYellowButtonDown when:{myWorld. #yellowButtonDown}.
self startScript: #onYellowButtonUp when:{myWorld. #yellowButtonUp}.
].
myWorld signal: #geometryChanged.
-
justDroppedInto: event:
-
-
CroquetParticipant {event handling}
-
justDroppedInto: aMorph event: anEvent
super justDroppedInto: aMorph event: anEvent.
World doOneCycleNow.
self removeProperty: #suppressStepping.
-
keyDown:
-
-
CroquetParticipant {event handling}
-
keyDown: anEvent
harness ifNil:[^nil].
harness keyDown: anEvent.
! !
-
keyStroke:
-
-
CroquetParticipant {event handling}
-
keyStroke: anEvent
harness keyStroke: anEvent.
! !
-
keyUp:
-
-
CroquetParticipant {event handling}
-
keyUp: anEvent
harness ifNil:[^nil].
harness keyUp: anEvent.
! !
-
lastEventAsMorphic
-
-
CroquetParticipantWithMenu {tweak rendering}
-
lastEventAsMorphic
^self tweakHand lastEvent.
-
localCacheFacetNames
-
-
KCroquetParticipant class {accessing}
-
localCacheFacetNames
"Answer the names of the facets available to local caches when connecting to the global cache."
^ #(joinFacet
leaveFacet
requestFacet
notifyFacet
uploadFacet)! !
-
make3DObject: from: player: rotateBy: replaceOldCostume:
-
-
BFDParticipant {3d sketch}
-
make3DObject: style from: aForm player: aPlayer rotateBy: rot replaceOldCostume: aBoolean
| bbForm tex mat scale space island tform tfm mesh pos frame t3dMesh |
style == #billboard ifTrue:[^self popUpBillboard: aForm player: aPlayer].
space := harness activeSpace.
island := harness activeIsland.
"Convert the form"
bbForm := Form extent: aForm extent asSmallerPowerOfTwo depth: 32.
aForm displayScaledOn: bbForm in: (bbForm boundingBox insetBy: 1).
"Smear the borders of the texture a bit to prevent problems in texture mapping"
bbForm smearFill: 10. "pixels - less is faster but more is safer"
"Create the texture"
tform := island future new: TForm.
tform future initialize: nil form: aForm mipmap: true
shrinkFit: true extension: #colorKeyZero.
tex := island future new: TTexture.
tex future initializeWithTForm: tform.
"The material"
mat := island future new: TMaterial.
mat future ambientColor: #(0.8 0.8 0.8 1) asFloatArray.
mat future diffuseColor: #(0.8 0.8 0.8 1) asFloatArray.
mat future texture: tex.
mat future textureMode: GLModulate.
"The t3d mesh"
t3dMesh := T3DSubdivision make3DMeshFrom: aForm style: style.
scale := 0.01.
tfm := (Quaternion axis: 1@0@0 angle: 180) asMatrix4x4.
tfm := tfm composeWith: (Quaternion axis: 0@1@0 angle: rot) asMatrix4x4.
tfm := tfm composeWith: (Matrix4x4 withScale: scale@scale@scale).
tfm := tfm composeWith: (Matrix4x4 withOffset: (aForm width * -0.5) @ (aForm height * -0.5) @ 0).
t3dMesh transformBy: tfm.
"The TMesh"
mesh := island future new: TMesh.
mesh future
initializeWithVertices: t3dMesh vertices
alias: nil
norms: t3dMesh vertexNormals
textureUV: t3dMesh texCoords
faceGroups: {1. t3dMesh zeroBasedFaceGroup}
material: mat.
mesh future solid: false.
mesh future initBounds.
frame := island future new: TDragger.
frame future contents: mesh.
"Position it"
pos := harness avatar translation - (harness avatar lookAt * 10).
frame future translation: pos.
frame future rotationAroundY: harness avatar yaw + rot.
space future addChild: frame.
-
makeWindowIn:
-
-
BFDParticipant {zoom navigator}
-
makeWindowIn: anIsland
"Create a window in the given space. This is an ugly solution but it works..."
windowData ifNil:[windowData := TIslandCopier new export: TWindow new].
^TIslandCopier new import: windowData to: anIsland.! !
-
mouseDown:
-
-
CroquetParticipant {event handling}
-
mouseDown: evt
evt setPosition: evt position - self bounds topLeft.
harness mouseDown: evt.
-
CroquetParticipantWithMenu {tweak rendering}
-
mouseDown: evt
" Did not really want to override this method, but the base CroquetParticipant adjusts
for morphic to croquet point conversion and we have already done that in our
tweak message loop (see self handleEvent:) "
harness mouseDown: evt.
-
mouseEnter:
-
-
CroquetParticipant {event handling}
-
mouseEnter: evt
evt setPosition: evt position - self bounds topLeft.
evt hand newKeyboardFocus: self.! !
-
CroquetParticipantWithMenu {event handling}
-
mouseEnter: evt
super mouseEnter: evt.
harness ifNotNil: [
harness openAL isCurrent ifFalse: [
harness makeOpenALCurrent.
].
].! !
-
mouseMove:
-
-
CroquetParticipant {event handling}
-
mouseMove: evt
evt setPosition: evt position - self bounds topLeft.
harness mouseMove: evt.! !
-
CroquetParticipantWithMenu {tweak rendering}
-
mouseMove: evt
" Did not really want to override this method, but the base CroquetParticipant adjusts
for morphic to croquet point conversion and we have already done that in our
tweak message loop (see self handleEvent:) "
harness mouseMove: evt.! !
-
KCroquetParticipant {tweak rendering}
-
mouseMove: evt
"Sometimes happens before we get initialized!!"
harness ifNil: [^false].
^super mouseMove: evt.! !
-
mouseOver:
-
-
CroquetParticipant {event handling}
-
mouseOver: evt
harness ifNil:[^nil].
harness pointerXY: evt position - self bounds topLeft.
-
CroquetParticipantWithMenu {tweak rendering}
-
mouseOver: evt
" Did not really want to override this method, but the base CroquetParticipant adjusts
for morphic to croquet point conversion and we have already done that in our
tweak message loop (see self handleEvent:) "
harness ifNil:[^nil].
harness pointerXY: evt position.
-
mouseUp:
-
-
CroquetParticipant {event handling}
-
mouseUp: evt
evt setPosition: evt position - self bounds topLeft.
harness mouseUp: evt.
-
CroquetParticipantWithMenu {tweak rendering}
-
mouseUp: evt
" Did not really want to override this method, but the base CroquetParticipant adjusts
for morphic to croquet point conversion and we have already done that in our
tweak message loop (see self handleEvent:) "
harness mouseUp: evt.
-
onBlueButtonDown
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onBlueButtonDown
"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
| selection bool |
selection := harness eventPointer selectedTarget.
(selection notNil) ifTrue: [
bool := selection future eventMask.
bool whenResolved: [
bool value = 0 ifTrue: [ self addHalo ].
].
self mouseDown: self lastEventAsMorphic.
]
ifFalse: [
self addHalo.
].
-
onBlueButtonUp
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onBlueButtonUp
"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
| selection bool |
selection := harness eventPointer selectedTarget.
(selection notNil) ifTrue: [
bool := selection future eventMask.
bool whenResolved: [
bool value = 0 ifTrue: [ self addHalo ].
].
self mouseUp: self lastEventAsMorphic.
]
ifFalse: [
self addHalo.
].
-
onKeyDown:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onKeyDown: event
self keyDown: event! !
-
onKeyStroke:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onKeyStroke: anEvent
^self keyStroke: anEvent! !
-
onKeyUp:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onKeyUp: event
self keyUp: event! !
-
onMouseDown
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onMouseDown
self mouseDown: self lastEventAsMorphic.
self startScript: #onMouseStillDown.
-
onMouseMove
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onMouseMove
| evt |
evt := self lastEventAsMorphic.
self mouseMove: evt.
self mouseOver: evt.! !
-
onMouseStillDown
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onMouseStillDown
self clock forEach: #tick do:[
self mouseMove: self lastEventAsMorphic.
].
-
onMouseUp
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onMouseUp
self stopScript: #onMouseStillDown.
self mouseUp: self lastEventAsMorphic! !
-
onYellowButtonDown
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onYellowButtonDown
self mouseDown: self lastEventAsMorphic.
self startScript: #onMouseStillDown.! !
-
onYellowButtonUp
-
-
CroquetParticipantWithMenu {tweak rendering}
-
onYellowButtonUp
self stopScript: #onMouseStillDown.
self mouseUp: self lastEventAsMorphic
-
openInWorld
-
-
CroquetParticipant {initialization}
-
openInWorld
super openInWorld.
World doOneCycleNow.
self removeProperty: #suppressStepping.
-
openTool:
-
-
BFDParticipant {zoom navigator}
-
openTool: toolClass
| tool window |
tool := toolClass new.
window := tool open.
self addMorphCentered: window.
tool postBuildIn: self.
^tool! !
-
participantFacetNames
-
-
KCroquetParticipant class {accessing}
-
participantFacetNames
"Answer the names of the facets available to participants: those able to both view and affect the replicated simulation."
^ #(joinFacet
sendFacet
syncFacet
heartbeatFacet
nil "beServerFacet"
leaveFacet
requestContentFacet
beContentServerFacet
nil "setRouterTimeFacet"
requestCacheFacet
nil "resetFacet")! !
-
popUpBillboard: player:
-
-
BFDParticipant {3d sketch}
-
popUpBillboard: aForm player: aPlayer
| space bbForm size billboard aPosition texture mat frame island tform camera |
space := harness activeSpace.
island := harness activeIsland.
size := aForm extent * 0.01.
bbForm := Form extent: aForm extent asSmallerPowerOfTwo depth: 32.
aForm displayScaledOn: bbForm in: (bbForm boundingBox insetBy: 1).
tform := island future new: TForm.
tform future initialize: nil form: aForm mipmap: true
shrinkFit: true extension: #colorKeyZero.
texture := island future new: TTexture.
texture future initializeWithTForm: tform.
billboard := island future new: TBillboard.
texture future aspect: size y / size x asFloat.
texture future extent: size * 3.
mat := island future new: TMaterial.
mat future ambientColor: #(1 1 1 0.99).
mat future diffuseColor: #(1 1 1 0.99).
mat future emissiveColor: #(1 1 1 0.99).
texture future material: mat.
billboard future addChild: texture.
"frame := island future new: TDragger.
frame future contents: billboard."
frame := billboard.
camera := harness camera.
aPosition := camera "avatar" translation - (camera "avatar" lookAt * 10).
frame future translation: aPosition.
space future addChild: frame.
-
renderMorphic:
-
-
CroquetParticipant {Morphic render}
-
renderMorphic: ogl
"Set up gl to provide overlay drawing - this is done in pixel coordinates"
| sz |
ogl glDisable: GLLighting.
self beginMorphicOverlay: ogl.
sz := harness formManager findCount.
sz > 0 ifTrue:[
ogl drawString: 'Textures to load: ', sz printString
at: 0@0@0 font: nil color: Color orange align: #topLeft].
self glRenderMorphicOverlayOn: ogl.
self endMorphicOverlay: ogl.
ogl glEnable: GLLighting.
-
CroquetParticipantWithMenu {render}
-
renderMorphic: ogl
"Set up gl to provide overlay drawing - this is done in pixel coordinates"
| sz |
ogl glDisable: GLLighting.
self beginMorphicOverlay: ogl.
"Display Tweak world"
self tweakWorld ifNotNil: [ self glRenderTweakOn: ogl ].
"Display stats and such"
self glRenderStatsOn: ogl.
sz := harness formManager findCount.
sz > 0 ifTrue:[
ogl drawString: 'Textures to load: ', sz printString
at: 0@0@0 font: nil color: Color orange align: #topLeft].
self glRenderMorphicOverlayOn: ogl.
self endMorphicOverlay: ogl.
ogl glEnable: GLLighting.
-
renderOverlay:
-
-
CroquetParticipant {Morphic render}
-
renderOverlay: ogl
self renderMorphic: ogl.! !
-
routerAddress
-
-
KCroquetParticipant {accessing}
-
routerAddress
^ address ifNil: [address := self class defaultRouterAddress]! !
-
routerAddress:
-
-
KCroquetParticipant {accessing}
-
routerAddress: anAddressString
address := anAddressString! !
-
routerPort
-
-
KCroquetParticipant {accessing}
-
routerPort
^ port ifNil: [port := self class defaultRouterPort].! !
-
routerPort:
-
-
KCroquetParticipant {accessing}
-
routerPort: anInteger
port := anInteger! !
-
runTweakCycle
-
-
CroquetParticipantWithMenu {tweak rendering}
-
runTweakCycle
| priorHand myWorld |
myWorld := self tweakWorld.
(self extent = myWorld display extent) ifFalse:[
myWorld extent: self extent.
].
priorHand := ActiveHand.
[
myWorld runCroquetCycle.
] ensure:[ActiveHand := priorHand].
-
scriptScheduler
-
-
CroquetParticipantWithMenu {tweak rendering}
-
scriptScheduler
^self valueOfProperty: #scriptScheduler! !
-
scriptScheduler:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
scriptScheduler: aScriptScheduler
^self setProperty: #scriptScheduler toValue: aScriptScheduler! !
-
serverFacetNames
-
-
KCroquetParticipant class {accessing}
-
serverFacetNames
"Answer the names of the facets available to servers: those authorized to make a copy of a snapshot of the simulation and send it to a newcomer."
^ #(joinFacet
sendFacet
syncFacet
heartbeatFacet
beServerFacet
leaveFacet
requestContentFacet
beContentServerFacet
setRouterTimeFacet
requestCacheFacet
resetFacet)! !
-
setDefaultRouterAddress
-
-
KCroquetParticipant class {accessing}
-
setDefaultRouterAddress
| addr initialAnswer |
initialAnswer := RouterAddress ifNil: [''].
addr := UIManager default
request: 'Enter IP address of default router'
initialAnswer: initialAnswer.
addr = '' ifTrue: [RouterAddress := nil] ifFalse: [RouterAddress := addr].! !
-
setup
-
-
BFDParticipant {initialization}
-
setup
| postcard |
harness := CroquetHarness new.
harness addOverlay: self.
postcard := TPostcard new routerAddress: nil "don't know what it is"
id: nil "don't know what it is"
name: 'Intro World'
viewpointName: #mainEntry.
harness viewPortal future postcardLink: postcard.
harness findViewpointByPostcard: postcard.
-
CroquetParticipant {initialization}
-
setup
"Try to set me up based on the master router"
harness := CroquetHarness new.
harness addOverlay: self.! !
-
KCroquetParticipant {initialization}
-
setup
| uname addr |
harness := self createHarness.
harness addOverlay: self.
"CroquetParticipantWithMenu removed the dock, just as things were getting layed out!!"
self addMorph: dock.
dock position: self position.
nav := KNavMorph new.
self addMorph: nav.
"This is also the method that is automatically used after e.g., toggleFullScreen."
nav snapToEdgeIfAppropriate.
"If we want unique logins..."
"uname := (UIManager default request: 'Enter user name'
initialAnswer: 'everyone').
"
uname := 'everyone'.
addr := self routerAddress.
harness defaultErrorHandler: (KMessageRouter dispatcher ifNil: [#indicateError:] ifNotNil: [#debug:]).
harness setupUser: uname
password: (uname= 'everyone' ifTrue: ['else']
ifFalse: [UIManager default requestPassword: 'Enter password'])
entry: self entry
address: addr
port: self routerPort.! !
-
showFrameRateString
-
-
CroquetParticipant {menu}
-
showFrameRateString
^(self fpsMorph ifNil:['<off>'] ifNotNil:['<on>']), 'show frame rate'! !
-
showPrimitiveStats
-
-
CroquetParticipantWithMenu {accessing}
-
showPrimitiveStats
"Answer whether to display texture statistics"
^self valueOfProperty: #showPrimitiveStats ifAbsent:[false]! !
-
showPrimitiveStats:
-
-
CroquetParticipantWithMenu {accessing}
-
showPrimitiveStats: aBool
"Indicate whether to display primitive statistics"
^self setProperty: #showPrimitiveStats toValue: aBool! !
-
shutdownTweakWorld
-
-
CroquetParticipantWithMenu {destroying}
-
shutdownTweakWorld
"shut down the tweak world - most importantly kill its scheduler"
| myScheduler i |
((self tweakWorld ~= nil) and: [self tweakWorld activeProject jabberListener ~= nil]) ifTrue: [
self tweakWorld activeProject jabberListener disconnect.
].
"self jabberClient ifNotNil:[ self jabberClient close]."
" Not sure if this is right, but it cleans the lingering CWorldPlayer. "
self tweakWorld: nil.
(i := Processor activeIsland) ifNotNil: [ i project: nil ].
myScheduler := self scriptScheduler.
"Note: scheduler cannot be terminated from within a script so fork off a new process which does the necessary stuff later on"
[myScheduler shutDown] forkAt: Processor userSchedulingPriority.! !
-
step
-
-
BFDParticipant {snapshots}
-
step
harness ifNotNil:[self updateSnapshots].
super step.! !
-
CroquetParticipant {stepping and presenter}
-
step
super step.
(self hasProperty: #suppressStepping) ifFalse:[
[harness
ifNil:[self setup]
ifNotNil:[harness step].
] ensure:[(self isInWorld and:[self isStepping not]) ifTrue:[self startStepping]].
].
self changed.! !
-
CroquetParticipantWithMenu {initialization}
-
step
super step.
self fpsMorph ifNotNil:[self fpsMorph step].
"NOTE: When tweakWorld is present its scheduler is aliased to my scheduler.
All script activity is then run from there."
self tweakWorld ifNil:[
self scriptScheduler ifNotNilDo:[:scheduler| scheduler runActiveScripts].
] ifNotNil:[
self runTweakCycle.
].! !
-
stepTime
-
-
CroquetParticipant {stepping and presenter}
-
stepTime
^Preferences higherPerformance ifTrue: [1] ifFalse: [20]! !
-
toggleFrameRate
-
-
CroquetParticipant {menu}
-
toggleFrameRate
self fpsMorph: (self fpsMorph ifNil:[FrameRateMorph new] ifNotNil:[nil])! !
-
toggleFullScreen
-
-
CroquetParticipant {menu}
-
toggleFullScreen
ScreenController lastScreenModeSelected
ifTrue:[
| priorBounds |
priorBounds := self
valueOfProperty: #priorBounds
ifAbsent:[0 @ 0 corner: 640 @ 480].
self bounds: priorBounds.
self removeProperty: #priorBounds.
ScreenController new fullScreenOff.
self world positionSubmorphs.
]
ifFalse:[
ScreenController new fullScreenOn.
self world positionSubmorphs.
self setProperty: #priorBounds toValue: self bounds.
self bounds: self world bounds.
self comeToFront.
].
-
CroquetParticipantWithMenu {menu}
-
toggleFullScreen
ScreenController lastScreenModeSelected
ifTrue:[
| priorBounds |
priorBounds := self
valueOfProperty: #priorBounds
ifAbsent:[0 @ 0 corner: 640 @ 480].
self bounds: priorBounds.
self removeProperty: #priorBounds.
ScreenController new fullScreenOff.
self world positionSubmorphs.
]
ifFalse:[
ScreenController new fullScreenOn.
self world positionSubmorphs.
self setProperty: #priorBounds toValue: self bounds.
self bounds: self world bounds.
self tweakWorld ifNotNil: [ self tweakWorld bounds: self world bounds ].
self comeToFront.
].
-
toggleNavButtons
-
-
KCroquetParticipant {actions}
-
toggleNavButtons
(submorphs includes: nav) ifTrue: [self removeMorph: nav]
ifFalse: [self addMorph: nav]. ! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
KCroquetParticipant class
instanceVariableNames: ''!
-
tweakCache
-
-
CroquetParticipantWithMenu {tweak rendering}
-
tweakCache
^self valueOfProperty: #tweakCache ifAbsentPut:[IdentityDictionary new]! !
-
tweakHand
-
-
CroquetParticipantWithMenu {tweak rendering}
-
tweakHand
"Answer a hand player or nil if not in Tweak"
| h |
^(h := Processor activeProcess hand) isPlayer
ifTrue: [h]
ifFalse: [self tweakWorld ifNotNilDo: [:w | w hands first]]
-
tweakWorld
-
-
CroquetParticipantWithMenu {tweak rendering}
-
tweakWorld
^self valueOfProperty: #tweakWorld! !
-
tweakWorld:
-
-
CroquetParticipantWithMenu {tweak rendering}
-
tweakWorld: myWorld
^self setProperty: #tweakWorld toValue: myWorld! !
-
updateSnapshots
-
-
BFDParticipant {snapshots}
-
updateSnapshots
(harness snapshots) = (dock snapshots collect:[:each| each snapshot]) ifFalse:[
dock snapshots: (harness snapshots collect:[:each| TSnapshotMorph new snapshot: each])
].
-
wantsDropFiles:
-
-
CroquetParticipant {event handling}
-
wantsDropFiles: anEvent
"Return true if the receiver wants files dropped from the OS."
^true! !
-
wantsSteps
-
-
CroquetParticipant {stepping and presenter}
-
wantsSteps
^true! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
CroquetParticipant class
instanceVariableNames: ''!
-
worlds
-
-
KCroquetParticipant class {accessing}
-
worlds
^ Worlds ifNil: [ {
UWIntroWorld. DungeonWorld. MarsWorld.
UWSpreadSheetWorld. T3BodyWorld. UWUnderwaterWorld.
WisconsinWorld. CritiquetWorld. QuiltersWorld. ForensicsWorld.
WisconsinNextWorld1. WisconsinNextWorld2
} ]
-
worlds:
-
-
KCroquetParticipant class {accessing}
-
worlds: aCollection
"Be able to bypass a hardcoded list in #worlds via a class variable Worlds"
Worlds := aCollection
! !