TGroup subclass: #QCannon
	instanceVariableNames: 'qpitch frequency lastTime balls nextSlot wheel mainChild active '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QCannon commentStamp: 'strick 9/27/2005 22:15' prior: 0!
The cannon owns the cannonballs, and a QCannonActivator.

The cannon is meta; its children are local.

Once activated, it starts firing cannonballs.

BUG -- the cannon only works at (0,0,0) , so there can only be one of them.
!


!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:34'!
activateAtTime: teaTime


	" cannon is meta, and this activation event was sent meta (and idempotent)
		but all responses are LOCAL.   
	There is no way (yet) to deactivate.  "

	active ifFalse: [


	frequency _ qpitch configureBallFrequency .
	lastTime_ teaTime - frequency.


	self stepTime: frequency * 1000 // 5. "one fifth the frequency, for smoothness of firing"
	self startStepping.
	"self step."

	active _ true.

	mainChild removeHint.


	].! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 22:01'!
allBalls

	| z | 

	z _ OrderedCollection new.

	balls do: [ :b |  b ifNotNil: [ z add: b ] ].

	^ z! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 01:36'!
ballsAt: nextSlot put: ball

		balls at: nextSlot put: ball.
! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:35'!
fireBaseTime: t

	" all the balls and firings are simulated LOCALLY. "

	| ball s gp  nextBall |

	"gp _ self globalPosition.
	gp ifNil: [^self]."

	gp _ B3DVector3 zero.


	ball _ balls at: nextSlot.

	ball ifNil: [

	" THESE META ARE WRONG -- activate SHOULD DO ALL THE META. "

		ball_ QCannonBall  new.
		ball  initializeWithPitch: qpitch.
		ball 
			baseLocation: gp 
			velocity: qpitch configureCannonDirection 
			baseTime:  t.

		s _ QCrudeSphere  new.
		s  radius: 0.5.
		ball  contents: s.

		ball  objectName: 'cannonball-', nextSlot.
		ball  colorize: (wheel at: nextSlot) asB3DColor.

		self  ballsAt: nextSlot put: ball.

		self  addChild: ball.

	] ifNotNil: [

		qpitch purgeFutureMessagesToBall: ball.

		ball
			baseLocation: gp 
			velocity: qpitch configureCannonDirection 
			baseTime:  t.
		ball colorize: (wheel at: nextSlot) asB3DColor.

	].


	nextSlot_ nextSlot + 1.
	(nextSlot > balls size) ifTrue: [ nextSlot_ 1. ].

	" turn balls black one step before the recycle "
	nextBall _ balls at: nextSlot.
	nextBall ifNotNil: [ nextBall colorize: Color black asB3DColor. ].

	^ ball
! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:37'!
initializeWithPitch: p
	
	" this messaage was sent META, but everything it does is simulated LOCALly. "

	qpitch _ p.
	active _ false.

	balls_ Array ofSize: qpitch configureNumberBalls.
	nextSlot_ 1.
	wheel_ Color wheel: balls size. "rainbow colors"


	" One white cube to represent the cannon.  LOCAL, not meta.  "
	mainChild_ QCannonActivator  new.
	mainChild  cannon: self.
	"mainChild  colorize: Color white asB3DColor."
	self  addChild: mainChild.
! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 08:19'!
step

	| now t  |

	now_ TeaTime now asSeconds.
	t_ lastTime+frequency.

	[ t < now ] whileTrue: [

		self fireBaseTime: t.

		lastTime _ t.
		t_ t + frequency.
	].
! !


TCube subclass: #QCannonActivator
	instanceVariableNames: 'cannon hintString '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QCannonActivator commentStamp: 'strick 9/27/2005 22:13' prior: 0!
QCannonActivator displays as a cube.  It is local, not meta.
It also displays the hint string.

When you mouse it down, it sends meta activate to the cannon.

When the cannon is activated,
this turns from orange to grey, and the hintString goes away.

!


!QCannonActivator methodsFor: 'accessing' stamp: 'strick 9/26/2005 01:21'!
cannon
	"Answer the value of cannon"

	^ cannon! !

!QCannonActivator methodsFor: 'accessing' stamp: 'strick 9/26/2005 01:21'!
cannon: anObject
	"Set the value of cannon"

	cannon _ anObject! !


!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 14:21'!
addHint


	" leave a hint how to start it "
	hintString _  TPrimitiveString new.

	hintString string: 'CLICK on the box in this corner to activate'.

	hintString translationX: 0.0 y: 2.0 z: 0.0 . " lift it up 2 units "

	self addChild: hintString.

	" Also turn ourself orange "
	self colorize: Color orange asB3DColor.

! !

!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 01:23'!
handlesPointerDown: pointer

	^ true.! !

!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 14:36'!
initialize

	" self is LOCAL not meat. "

	super initialize.

	self addHint.


! !

!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 01:28'!
isComponent

	^ true.! !

!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:32'!
pointerDown: ptr

	" cannon is META and activation event is META (and idempotent). "

	cannon meta activateAtTime:  TeaTime now asSeconds.
! !

!QCannonActivator methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:41'!
removeHint

	" no longer need the hintString "

	hintString ifNotNil: [
		self removeChild: hintString.
		hintString _ nil.

		"and no longer need to be orange."
		self colorize: Color darkGray asB3DColor.

	].

! !


TGroup subclass: #QCannonBall
	instanceVariableNames: 'qpitch collision contents baseLocation baseTime velocity shadow '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QCannonBall commentStamp: 'strick 9/27/2005 22:10' prior: 0!
Cannonballs are shot out of the cannon.

They are in local simulations; they are not meta.

They only react by hitting carpets and the walls (which are carpets without QDraggers).

Oh, and they smack Avatars.
!


!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:53'!
baseLocation

	^ baseLocation! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 21:59'!
baseLocation: loc velocity: v baseTime: t

	| c msg |
	collision _ nil.

	baseLocation_ loc.
	velocity_ v.
	baseTime_ t.

	qpitch ifNotNil: [

		qpitch allObstacles do: [ :o |

QPitch spew: [ ' Ball= ', self, 
			" ' globalT= ', (self globalTransform),  "
			" ' localXlate= ' , ( self translation ),   "
			' TestingObstacle= ', o  
].

	" new way "
			c _ o computeCollisionWithBall: self.
			( 
				( c notNil ) and:
				[ collision isNil or: [ c when < collision when ]] and:
				[ c when > (t + o epsilon) ] 
			) ifTrue: [
				collision _ c.
			].

		].
	].

QPitch spew: [ 'Ball ', self, ' Pitch ' , qpitch , ' Collision ', collision ].

	collision ifNotNil: [

		msg _ QFutureMessage new.
		msg when: collision when.
		msg receiver: self.
		msg message: #executeCollision: .
		msg args: (Array with: collision).

QPitch spew: [ 'FUTURE-MESSAGE When ', ((collision when * 1000) asInteger), 'ms ---> Collision ', collision ].

		qpitch addFutureMessage: msg.

	].! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:53'!
baseTime

	^ baseTime! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 08:13'!
contents: x

	contents _ x.
	self addChild: contents.! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 19:05'!
executeCollision: collision

	" we are sent to ball, so messages can be purged by ball.
		however it is the carpet that decides what to do with a collision,
		so we dispatch it there. "

	collision carpet executeCollision: collision.
! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 23:34'!
fixShadow

	shadow ifNil: [
	   QPitch simplify ifFalse: [
		shadow _ TRectangle new.
		shadow colorize: Color black asB3DColor.
		shadow rotationAroundX: -90.0 .
		shadow extent: 0.3 @ 0.3.
		self addChild: shadow.
		self fixShadow.
	]].


	shadow ifNotNil: [
		shadow 
			translationX: 0.0 
			y: 0.001 + ( self translation y negated ) 
			z:0.0 
	].! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/19/2005 18:13'!
globalBaseLocation

	^  self localToGlobal: (self localTransform localPointToGlobal: baseLocation).! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 18:16'!
initialize


	super initialize.
! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 23:32'!
initializeWithPitch: p

	qpitch _ p.

	baseLocation _ B3DVector3 zero.
	velocity _ nil .
	baseTime _ TeaTime now asSeconds.

	self stepTime: 50.
	self startStepping.! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 18:17'!
qpitch

	^ qpitch! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 23:36'!
step
	| factor x y z |
	velocity ifNotNil: [
	contents ifNotNil: [
			factor _ TeaTime now  asSeconds - baseTime.
			x _ baseLocation x + (factor * velocity x).
			y _ baseLocation y + (factor * velocity y).
			z _ baseLocation z + (factor * velocity z).

			self
				translationX: x
				y: y
				z: z.
		]].

	super step.

	"fixShadow."! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:54'!
velocity

	^ velocity! !


TSphere subclass: #QCrudeSphere
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QCrudeSphere commentStamp: 'strick 9/25/2005 21:38' prior: 0!
A QCrudeSphere is a TSphere with cruder rendering segments (4x4 instead of 10x10).!


!QCrudeSphere methodsFor: 'nil' stamp: 'strick 9/25/2005 21:36'!
initialize


	super initialize.
	segments _ 4.! !


TSpinner subclass: #QDragger
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QDragger commentStamp: 'strick 9/27/2005 22:08' prior: 0!
A QDragger is a TSpinner, with the SHIFT key reversed:  

  -- no SHIFT to translate
  -- SHIFT to rotate
  -- spinning (after you let go) disabled.
!


!QDragger methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 22:12'!
initialize

	super initialize.

	self matOver: nil.
	self matDown: nil.
	self matNorm: nil.
! !

!QDragger methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 23:11'!
pointerMove: pointer
	| delta trans |

	"Copied this while dang thing from TSpinner, and changed #ifTrue to #ifFalse on first line"

	pointer event2D shiftPressed ifFalse:[
		(pointer frame: self pickPlane: selectedPoint normal: cameraNorm) ifTrue:[
			delta _ selectedPoint - pointer selectedPoint.
			self meta translation: (self translation - (self orientation localPointToGlobal: delta)).
		^ true.]. ^ false.].

"ROTATE AROUND"

	pointer frame: self pickSphere: B3DVector3 new radiusSquared: selectedRadiusSquared.
	lastSpin _ (self rotFromBallPoints: selectedPoint to: pointer selectedPoint) asMatrix4x4.
		trans _ self translation.
	self translationX: 0.0 y:0.0 z:0.0.
	self localTransform: (self localTransform composeWith: lastSpin).
	self translation: trans.
	self meta localTransform: localTransform clone.
	^ true.

! !

!QDragger methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 21:59'!
spin: ignoredNumber

	super spin: nil.! !


Object subclass: #QFutureList
	instanceVariableNames: 'list '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QFutureList commentStamp: 'strick 9/27/2005 22:18' prior: 0!
QFutureList is probably 100% redundant with the ordinary Tea message sending stuff.

But it's fairly simple anyway, and it is only used for local (not meta) messages
concerning when balls collide with carpets.

!


!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:27'!
add: item

	^ list add: item.! !

!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 22:23'!
getFirstMessageBefore: timeNow

	| m |

	 list size > 0   ifTrue: [

		m _ list at: 1.


		m when < timeNow   ifTrue: [
			list removeFirst.
			^ m.
		].


	].

	^ nil  " no appropriate message "
! !

!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:56'!
initialize

	list _ SortedCollection new.
! !

!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:29'!
printOn: aStream

	aStream addAll: 'QFutureList(', list, ')'.
! !

!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 21:20'!
purgeDeadReceiver: r

	" when we recycle cannonballs, we need to remove all FutureMessages being sent to its old state. "

	list removeAllSuchThat: [ :msg |

		msg receiver == r
	].! !

!QFutureList methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:52'!
sendAllMessagesBefore: timeNow

	| m |

	[ nil ~~ (m _ self getFirstMessageBefore: timeNow) ]  whileTrue: [

		m sendIt.

	].

	
! !


Object subclass: #QFutureMessage
	instanceVariableNames: 'when receiver message args '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QFutureMessage commentStamp: 'strick 9/27/2005 22:19' prior: 0!
QFutureMessages are the things held in the QFutureList.

Basically they say a ball will collide at a certain time.
!


!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
args
	"Answer the value of args"

	^ args! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
args: anObject
	"Set the value of args"

	args _ anObject! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
message
	"Answer the value of message"

	^ message! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
message: anObject
	"Set the value of message"

	message _ anObject! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
receiver
	"Answer the value of receiver"

	^ receiver! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
receiver: anObject
	"Set the value of receiver"

	receiver _ anObject! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
when
	"Answer the value of when"

	^ when! !

!QFutureMessage methodsFor: 'accessing' stamp: 'strick 9/18/2005 21:34'!
when: anObject
	"Set the value of when"

	when _ anObject! !


!QFutureMessage methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 22:36'!
<= other

	^ self when <= other when! !

!QFutureMessage methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:38'!
sendIt

	#please send: message to: receiver withArguments: args.

! !


TGroup subclass: #QPitch
	instanceVariableNames: 'blueCannon redCannon carpets walls xSize ySize zSize futureList '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QPitch commentStamp: 'strick 9/27/2005 22:16' prior: 0!
The toplevel TFrame for Strick's "Q" game that
is slightly reminiscent of Quidditch.

It owns the cannons, the carpets, the walls, and a FutureList object.

It also has a method to steal and reconfigure the floor.

Unlike other Teapot demos, the minimum corner of the game is at (0,0,0)
and everything interesting extends in the positive directions.

BUG -- the QPitch is meta, but things are not sorted out how it sends meta.
So this only works if the QPitch is "common knowledge" -- that is, instantiated by QPot
before connections are made.

!


!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:40'!
addCannonAt: position pointing: direction


	" creating a cannon is meta -- but usually is done before connections. "


	|  c  |

	c_ QCannon meta new.
	c meta translation: position.

	c meta initializeWithPitch: self.

	self meta addChild: c.

	^c.! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:05'!
addCarpets: n

	
	| carpet dragger z i |

z _ OrderedCollection new.
i _ 1.

(Color wheel: n) do: [ : color |
	carpet _ QQCarpet meta new initializeWithQPitch: self.
	carpet objectName: 'carpet/',i.
	carpet meta colorize: color  asB3DColor.


	dragger _ QDragger meta new.
	dragger objectName: 'dragger/',i.
	dragger meta contents: carpet.
"
	dragger meta 
		translationX: color red * xSize 
		y: color green * ySize 
		z: color blue * zSize.
"
	dragger meta 
		translationX: ( 2.0 * Float pi * i asFloat / n asFloat )  sin * (ySize/2.0) + (xSize/2)
		y: carpet extent y / 2.0 
		z:  ( 2.0 * Float pi * i asFloat / n asFloat )  cos * (ySize/2.0) + (zSize/2).

	carpet meta rotationAroundY:  ( 360.0 * i asFloat / n asFloat ) + 90 .

	self meta addChild: dragger.

	z add: carpet.

	i _ i+1.
].

	^ z! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 22:17'!
addFutureMessage: msg

	futureList add: msg.
! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 18:33'!
addWalls

	| w z  txt |

	z _ OrderedCollection new: 4.

	" blue endzone "

	w _ QQCarpet meta new initializeWithQPitch: self.
	w objectName: 'BlueEndzone'.
	w meta extent: xSize @ ySize.
	w meta translationX: xSize/2 y: ySize/2 z: 0.
	w meta colorize: (Color blue twiceLighter asB3DColor alpha: 0.2).
	self meta addChild: w.
	z add: w.

	" red endzone "

	w _ QQCarpet meta new initializeWithQPitch: self.
	w objectName: 'RedEndzone'.
	w meta extent: xSize @ ySize.
	w meta translationX: xSize/2 y: ySize/2 z: zSize.
	w meta colorize: (Color red twiceLighter asB3DColor alpha: 0.2).
	self meta addChild: w.
	z add: w.

	" side walls "

 	( Array with: 0.0 with: xSize ) do: [ :xTrans |

		w _ QQCarpet meta new initializeWithQPitch: self.
		w objectName: 'SideLine',xTrans .
		w meta extent: zSize @ ySize.
		w meta rotationAroundY: 90.
		w meta translationX: xTrans y: ySize/2 z: zSize/2.
		w meta colorize: (Color white muchLighter asB3DColor alpha: 0.1).
		self meta addChild: w.
		z add: w.
	].

	" ceiling "

	w _ QQCarpet meta new initializeWithQPitch: self.
	w objectName: 'ceiling'.
	w meta extent: xSize @ zSize.
	w meta rotationAroundX: 90.
	w meta translationX: xSize/2 y: ySize z: zSize/2 .
	w meta colorize: (Color black twiceLighter asB3DColor alpha: 0.2).
	self meta addChild: w.
	z add: w.


	" floorCarpet "

	w _ QQCarpet meta new initializeWithQPitch: self.
	w objectName: 'floorCarpet'.
	w meta extent: xSize @ zSize.
	w meta rotationAroundX: 90.
	w meta translationX: xSize/2 y: -0.001 z: zSize/2 .
	"w meta colorize: (Color gray asB3DColor alpha: 0.5)."
	self meta addChild: w.
	z add: w.


	txt _ TTexture
				new initializeWithFileName: 'moonmap.jpg'
				mipmap: true
				shrinkFit: false.
	txt uvScale: 6.0@10.0.

	w meta texture: txt.


	^ z! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 21:17'!
adjustFloorIn: root

	| floor  |

	 "actualy we delete the floor, because we now add a textured Carpet wall object there."

	floor _ self findFloorIn: root.
	root removeChild: floor.
! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 18:51'!
allObstacles

	| z |

	z _ OrderedCollection new.

	carpets ifNotNil: [ z addAll: carpets. ].
	walls ifNotNil: [z addAll: walls. ].

	^z! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 18:52'!
configureBallFrequency

	^ 1.3! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:43'!
configureCannonDirection

	" which way, and how fast, the cannon shoots its cannonballs "

	"^ (B3DVector3 x: 7.7 y:0.1 z: 5.1) * 1.5"


	^ (B3DVector3 x: 2 * Float pi y: 0.1 z: 23 sqrt )! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:30'!
configureLengthOfPitch

	^ 100.0! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:42'!
configureNumberBalls

	^ 99! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:41'!
configureNumberCarpets

	^ 13! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 12:18'!
findFloorIn: root

	| floors floor |

	floor _ nil.
	floors _ root find: [ : x | x objectName = 'floor' ]. 

	( floors size > 0 ) ifTrue: [
		floor _ floors at: 1.
	].

	^floor
	! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/27/2005 15:48'!
initialize

	" There are some meta problems here.  
	For now, dont make pitches after connection.
	Most of this method should be in a #constructMetaParts
	method that only the creator sends.

	actually, what are the rules for when #initialize is sent?
	how is it different from #new?
	what method is executed only on the node creating self?
	"

	super initialize.

	futureList _ QFutureList new initialize.

	self length: self configureLengthOfPitch .

	carpets _ self addCarpets: self configureNumberCarpets.

	blueCannon _ self 
			addCannonAt: (B3DVector3 x: 0.0 y:0.0 z: 0.0) "(B3DVector3 x: 1.0 y:1.0 z: 1.0)" 
			pointing: self configureCannonDirection.
"
	redCannon _ self 
			addCannonAt:(B3DVector3 x: self xSize - 1.0 y:1.0 z: self zSize - 1.0)
			pointing: (B3DVector3 x: 9.9 y:0.9 z: 4.1).
"

	walls _ self addWalls.

	" to process future messages "
	self stepTime: 50.
	self startStepping.

	" crosshairs at origin "
	self addChild: TFrame new.



! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:53'!
length

	" the main length factor is the z length "

	^ zSize! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 12:08'!
length: len

	" the main length factor is the z length "

	zSize _ len * 1.0 .
	xSize _ zSize / self class goldenRatio.
	ySize _ xSize / self class goldenRatio.! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 21:24'!
purgeFutureMessagesToBall: ball

	futureList purgeDeadReceiver: ball.
! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 22:03'!
recalculateAllBalls

	blueCannon allBalls do: [ :b |

		b baseLocation: (b baseLocation) velocity: (b velocity) baseTime: (b baseTime)

	].! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 22:06'!
step


	futureList sendAllMessagesBefore: TeaTime now asSeconds.
	
	"self recalculateAllBalls."

! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:57'!
xSize

	^ xSize! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:57'!
ySize

	^ ySize! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:56'!
zSize

	^ zSize! !

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

QPitch class
	instanceVariableNames: ''!

!QPitch class methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:05'!
goldenRatio

	^ 1.6180339887! !

!QPitch class methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 23:24'!
simplify

	^ false.! !

!QPitch class methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 14:52'!
spew2: aStringProducingBlock

	" only for debugging.  turn Transcripting on or off here. "

	true
		ifTrue: 
			[ Transcript cr; show: ( '* ', aStringProducingBlock value ) ].! !

!QPitch class methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 21:06'!
spew: aStringProducingBlock

	" only for debugging.  turn Transcripting on or off here. "

	false
		ifTrue: 
			[ Transcript cr; show: ( '* ', aStringProducingBlock value ) ].! !


TeapotMorph subclass: #QPot
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QPot commentStamp: 'strick 9/27/2005 22:03' prior: 0!
The TeapotMorph class for Strick's "Q" game that
is slightly reminiscent of Quidditch.

This class has class methods that cause a QPot icon to appear
n the Croquet section of the "objects" thingy.


==================================================

	           BUGS

-- When you move a carpet (colored rectangle), balls do not recalculate
   their next collision.  Only balls that have bounced after you moved it
   will bounce off of it correctly.  That means there is usually a lag of 1 to 6 balls
   before your carpet takes effect.  Be patient!!

-- Sometimes one side of a carpet works and the other doesn't.  Or if you just
   tweak the carpet a bit, it might work.

-- One side of the carpet behaves backwards when you rotate it (left click with SHIFT).

-- Only one cannon will work, and it must be at (0, 0, 0).

                FEATURES

Use SHIFT to rotate a carpet.  It's the opposite of TSpinner.

When a ball hits an avater, it may knock it away.  A long ways, even.
Or the avatar may ride on it. [ This just worked.  It is very cool. ]

See QPitch instance methods for configuration variables.
!


!QPot methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 21:19'!
initializeDefaultSpace
	| space light tframe pitch |

	"space is the place"
	space _ TSpace new.
	space url: 'http://www.reed.com/TeaLand/spaces/intro.tea'.

	"Add a light to the world "
	light _ TLight new.
	tframe _ TSpinner new.
	tframe translationX: -10 y:0.0 z: 0.0.
	tframe rotationAroundZ: 120.
	tframe matNil.
	tframe contents: light.
	space addChild: tframe.


	"create the floor"
	self makeFloor: space fileName:'stone.BMP'.

	"what is this?"
	self makePopUp: space.


	" now the Q pitch.... "
	
	pitch _ QPitch meta new.
	space meta addChild: pitch.

	" steal that floor we made earlier "
	"( pitch should probably make its own floor, not steal one. )"
	pitch adjustFloorIn: space.  

	^space! !

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

QPot class
	instanceVariableNames: ''!

!QPot class methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:20'!
descriptionForPartsBin
	^ self partName:	(self name)
		categories:		#('Croquet')
		documentation:	'Croquet Q Game'
		sampleImageForm: TForm defaultForm.
! !

!QPot class methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:20'!
includeInNewMorphMenu

	^true! !


TGroup subclass: #QQCarpet
	instanceVariableNames: 'front back extent qpitch impactCube center nw se '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QQCarpet commentStamp: 'strick 9/23/2005 16:36' prior: 0!
A Carpet is an obstacle in a QPitch.  Balls hit them, and things happen, like they bounce off it.

The carpet is displayed by two TRectangles.

Carpets translate and rotate by localTransform, but do not scale.
Therefore they have an 'extent', just like the two TRectangles do, to know their size.

In local coordinates, carpets always live in the plane z=0, with their extent
centered around (0,0,0).

!


!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:39'!
colorize: c

	"super colorize: c."

	front colorize: c.
	back colorize: c asColor duller asB3DColor.! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:41'!
computeCollisionWithBall: b

	| localBallBaseLocation localBallBaseVelocity when where collision x y duration |

	" easier to compute in Carpet's local coordinates " 

"8 frob."

	localBallBaseLocation _ self globalToLocal: b baseLocation.
	localBallBaseVelocity _ (self globalToLocal: b velocity) - (self globalToLocal: B3DVector3 zero).

	" collision in local coordinates is when z=0 "
	duration _ ( localBallBaseLocation z / localBallBaseVelocity z ) negated.
	when _ b baseTime + duration.

"QPitch spew2: ['Carpet ', self, ' Duration ', duration.]."
	(duration < self epsilon) ifTrue: [ ^ nil ].

	"(when < (b baseTime + self epsilon))  ifTrue:  [ ^ nil ]."

	" x and y of collision, in local coordinates "
	x _ localBallBaseLocation x + (duration * localBallBaseVelocity x).
	y _ localBallBaseLocation y + (duration * localBallBaseVelocity y).

	" multiply x and y times 2.0, because only half the extent is on either side of origin. "
	(x*2.0 between: extent x negated and: extent x) ifFalse: [ ^ nil ]. 
	(y*2.0 between: extent y negated and: extent y) ifFalse: [ ^ nil ]. 

	" where, in global coordinates "
	where _ b baseLocation + ( duration * b velocity ).

	collision _ QQCollision new.
	collision ball: b; carpet: self; when: when; where: where; 
		localX: x; localY: y; localVelocity: localBallBaseVelocity.
	^ collision



	! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:31'!
defaultSize

	^ 5.0 ! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:39'!
epsilon

	" a very small fudge amount, so rounding error do not create near misses "

	^ 0.001.    "about a millisecond or a millimeter"! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/26/2005 00:40'!
executeCollision: c

	" bouncing off a carpet is easy to calculate in LOCAL coordinates,
		since the carpet lives in z=0.0 : just negate the z component
		of the carpet-local velocity.
	"

	|  oldLocalVelocity  newLocalVelocity newGlobalVelocity |

"QPitch spew2: [ '--Collision: ', c.] "

	oldLocalVelocity _ c localVelocity.

	newLocalVelocity _ B3DVector3 
		x: oldLocalVelocity x
		y: oldLocalVelocity y
		z:  0.0 - oldLocalVelocity z.


	newGlobalVelocity _ (self localToGlobal: newLocalVelocity) - (self localToGlobal: B3DVector3 zero).

	c ball 
		baseLocation: c where 
		velocity: newGlobalVelocity 
		baseTime: c when.

	impactCube translationX: c localX y: c localY z: 0.0 .

! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 21:26'!
extent: e

	extent _ e.
	front extent: e.
	back extent: e.

	nw ifNotNil: [
	nw translationX: (e x / 2.0) y: (e y / 2.0 ) z: 0.0 ] .

	se ifNotNil: [
	se translationX: (e x / 2.0) negated y: (e y / 2.0 ) negated z: 0.0 ] .
! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/25/2005 21:26'!
initialize

	super initialize.

	front _ TRectangle new.
	back _ TRectangle new.

	back rotationAroundY: 180.

	self addChild: front.
	self addChild: back.

"
	center _ TCube new  extentX: 0.1 y: 0.1 z: 0.1 .
	center colorize: Color orange asB3DColor.
	self addChild: center.

	nw _ TCube new  extentX: 0.1 y: 0.1 z: 0.1 .
	nw colorize: Color orange asB3DColor.
	self addChild: nw.

	se _ TCube new  extentX: 0.1 y: 0.1 z: 0.1 .
	se colorize: Color orange asB3DColor.
	self addChild: se.
"

	impactCube _ TCube new.
	impactCube extentX: 0.1 y: 0.1 z: 0.1 .
	impactCube colorize: Color white asB3DColor.
	self addChild: impactCube.

! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:30'!
initializeWithQPitch: q

	qpitch _ q.

	self extent: ( QPitch goldenRatio * self defaultSize ) @ self defaultSize . ! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:42'!
printOn: aStream

	"use the objectName to make these friendly"

	| name |

	name _ self objectName.
	name ifNil: [ name _ self identityHash. ].

	aStream nextPutAll: 'QQC"', name, '"'.! !

!QQCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 16:43'!
texture: t

	front texture: t.
	back texture: t.! !


Object subclass: #QQCollision
	instanceVariableNames: 'when where ball carpet localX localY localVelocity '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QQCollision commentStamp: 'strick 9/27/2005 22:06' prior: 0!
QQCollision is just a record holding data slots.

It describes a future or present collision of a ball with a carpet.
Some of the data is in the carpet's local coordinates, since it is easier for the
carpet to use that way.  (Since the carpet is in z=0, things reduce to 2- or 1-dimentional
problems in its local coordinates.)!


!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
ball
	"Answer the value of ball"

	^ ball! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
ball: anObject
	"Set the value of ball"

	ball _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
carpet
	"Answer the value of carpet"

	^ carpet! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
carpet: anObject
	"Set the value of carpet"

	carpet _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/25/2005 18:05'!
localVelocity
	"Answer the value of localVelocity"

	^ localVelocity! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/25/2005 18:05'!
localVelocity: anObject
	"Set the value of localVelocity"

	localVelocity _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 18:52'!
localX
	"Answer the value of localX"

	^ localX! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 18:52'!
localX: anObject
	"Set the value of localX"

	localX _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 18:52'!
localY
	"Answer the value of localY"

	^ localY! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 18:52'!
localY: anObject
	"Set the value of localY"

	localY _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
when
	"Answer the value of when"

	^ when! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
when: anObject
	"Set the value of when"

	when _ anObject! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
where
	"Answer the value of where"

	^ where! !

!QQCollision methodsFor: 'accessing' stamp: 'strick 9/23/2005 17:34'!
where: anObject
	"Set the value of where"

	where _ anObject! !


!QQCollision methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 18:59'!
printOn: aStream


	aStream nextPutAll: 'Collision(', 
		ball, ',',
		carpet, ',',
		when, ',',
		( localX @ localY ), ',',
		where, ')'.! !


TestCase subclass: #QQTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!
!QQTests commentStamp: 'strick 9/27/2005 22:06' prior: 0!
just one basic test of collision.!


!QQTests methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 17:53'!
setUp

	" no setup "! !

!QQTests methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 19:06'!
testCollision1

	" QQTests new setUp testCollision1  "

	| ball carpet collision |

	ball _ QCannonBall new initialize.
	ball
		baseLocation: ( B3DVector3 x: 0.1 y: 0.1 z: -10.0 )
		velocity: ( B3DVector3 x: 0.1 y: 0.1 z: 8.0 )
		baseTime: 100.0 .

	carpet _ QQCarpet new initialize.
	carpet initializeWithQPitch: nil.
	carpet rotationAroundY: 3.
	carpet translationX: 0.0 y: 0.0 z: 5.0.

	collision _ carpet computeCollisionWithBall: ball.

	self assert: (collision when between: 101.8 and:  101.9).

	self assert: (collision localX between: 0.285 and: 0.29 ).
	self assert: (collision localY between: 0.285 and: 0.29 ).

	self assert: (collision where x between: 0.285 and: 0.29 ).
	self assert: (collision where y between: 0.285 and: 0.29 ).
	self assert: (collision where z between: 4.9 and: 5.0 ).

	^ collision! !

!QQTests methodsFor: 'as yet unclassified' stamp: 'strick 9/23/2005 17:53'!
testTest

 	self assert: true.
 	self deny: false.! !