TGroup subclass: #QCannon
	instanceVariableNames: 'qpitch frequency lastTime balls nextSlot wheel mainChild '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/16/2005 12:16'!
addChild: x

	"but first,
		remove the old child at this slot, if it exists and we are still its parent,
		to limit the number of cannonballs"

	| old |

	old_ balls at: nextSlot.

	old ifNotNil: [
		(old parent == self) ifTrue: [
			self removeChild: old.
		].
	].

	x colorize: (wheel at: nextSlot) asB3DColor.
	balls at: nextSlot put: x.

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

	^super addChild: x.
! !

!QCannon methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 21:10'!
fireBaseTime: t

	| ball s gp  nextBall |

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

	gp _ B3DVector3 zero.


	ball _ balls at: nextSlot.

	ball ifNil: [

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

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

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

		balls at: nextSlot put: ball.

		super 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/18/2005 18:18'!
initializeWithPitch: p

	qpitch _ p.

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

	frequency _ qpitch configureBallFrequency .
	lastTime_ TeaTime now asSeconds - frequency.

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

	" One white cube to represent the cannon. "
	mainChild_ TCube new.
	mainChild colorize: Color white asB3DColor.
	super 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.
	].
! !


TGroup subclass: #QCannonBall
	instanceVariableNames: 'qpitch collision contents baseLocation baseTime velocity lastPlaneCollidedWith '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

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

	| c msg |
	collision _ nil.

	baseLocation_ loc.
	velocity_ v.
	baseTime_ t.

qpitch ifNil: [ 8 frob ].

	qpitch ifNotNil: [

		qpitch allObstacles do: [ :o |

			o qplane ifNil: [ o globalTransformUpdate. ].


QPitch spew: [ 'testing RE-COLLISION:  Ball= ', self,  ' Obstacle= ', o    ].
QPitch spew: [ '-----------------  ', lastPlaneCollidedWith identityHash , ' ?? ', o qplane identityHash  ].

			"( lastPlaneCollidedWith == o qplane ) ifTrue: [

QPitch spew: [ 'IGNORING RE-COLLISION:  Ball= ', self,  ' Obstacle= ', o  ].

			] ifFalse: ["

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

			  c _ QPlaneIntersection new 
				intersect: (o qplane) 
				withPointStartingPosition: baseLocation " XXXXXXself globalBaseLocation" 
				time: baseTime 
				velocity: velocity.

			  c willIntersect  ifTrue: [
				( (collision isNil) or: [ c when < collision when ] ) 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: #bounceOff:intersection:.
		msg args: (Array with: collision qplane clone with: collision).

QPitch spew2: [ 'FUTURE-MESSAGE When ', ((collision when * 1000) asInteger), 'ms  Ball ', self, ' Pitch ' , qpitch , ' Collision ', collision ].

		qpitch addFutureMessage: msg.

	].! !

!QCannonBall methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 23:04'!
bounceOff: aQPlane intersection: intersection

	| normal vNormNeg newVelocity dotProduct rot  |


QPitch spew2: [ '######################## Bouncing ', self, ' off of ', aQPlane, '.  ' ].
QPitch spew2: [ '##### intersection: ', intersection ].
QPitch spew2: [ '##### velocity: ', velocity ].

	normal _ aQPlane normal.

	vNormNeg _ velocity normalized negated.

QPitch spew2: [ '##### normal ', normal ].
QPitch spew2: [ '##### vNormNeg ', vNormNeg ].
QPitch spew2: [ '##### intersection: ', intersection ].

	dotProduct _ ( normal dot: vNormNeg ).
	dotProduct < 0  ifTrue: [ normal _ normal negated. ].

QPitch spew2: [ '##### dotProduct  ', dotProduct ].

QPitch spew: [ '##### normal ', normal ].
QPitch spew2: [ '##### intersection: ', intersection ].

	
	"rot _ vNormNeg rotationTo: normal."
	" The following seems backwards, but it is what works. "
	rot _ normal rotationTo: vNormNeg.

	newVelocity _ ( rot productFromVector3: normal ) * ( velocity length ).


QPitch spew2: [ '##### newVelocity ', newVelocity  ].
QPitch spew2: [ '##### intersection: ', intersection ].

	lastPlaneCollidedWith _ aQPlane.

	self baseLocation: intersection where velocity: newVelocity baseTime: intersection when.! !

!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/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/20/2005 21:54'!
initializeWithPitch: p

	qpitch _ p.
	lastPlaneCollidedWith _ nil.


	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/19/2005 17:50'!
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).

			contents
				translationX: x
				y: y
				z: z.
			"self update ???"
		]].
	super step! !


TGroup subclass: #QDoubleRectangle
	instanceVariableNames: 'front back qplane '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 18:48'!
boundingBox

	" this is not being magically figured out by anything "

	| a b fe |

	fe _ front extent.

	a _ self localToGlobal: ( B3DVector3 x: fe x / -2.0 y: fe y / -2.0 z: fe z / -2.0 ).
	b _ self localToGlobal: ( B3DVector3 x: fe x /  2.0 y: fe y /  2.0 z: fe z /  2.0 ).
"
	a _ self localToGlobal: ( B3DVector3 zero - ( front extent / 2 ) ).
	b _ self localToGlobal: (  front extent / 2  ).
"
	^ TBox new min: a max: b.! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 22:32'!
colorize: c

	super colorize: c.

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

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 08:25'!
extent: e

	front extent: e.
	back extent: e.! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 16:30'!
globalCenter

	^ globalTransform localPointToGlobal: (B3DVector3 zero).! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 16:36'!
globalNormal

	^ globalTransform orientation localPointToGlobal: (B3DVector3 x: 0.0 y: 0.0 z: 1.0 )! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 14:13'!
globalTransformUpdate

	" Recalculate the qplane whenever globalTransform is updated. "

	qplane _ QPlane new point: self globalCenter normal: self globalNormal boundingBox: self boundingBox.

	^super globalTransformUpdate! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 21:23'!
initialize

	super initialize.

	globalTransform ifNil: [ globalTransform _ B3DMatrix4x4 identity ].

	front _ TRectangle new.
	back _ TRectangle new.

	back rotationAroundY: 180.
"
	front colorize: ( Color green asB3DColor alpha: 0.8 ).
	back colorize: ( Color lightGreen asB3DColor alpha: 0.8 ).
"
	self addChild: front.
	self addChild: back.

	self stepTime: 100.
	self startStepping.

! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:09'!
qplane

	" the qplane represents the plane of the rectangles in GLOBAL coordinates.
	  Manipulating the doubleRectangle changes the globalTransform.

	  qplane is updated by #update and caches a center and a normal.
	"
	

	qplane ifNil: [ self globalTransformUpdate ].

	^ qplane! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 18:41'!
step

	^ super step! !

!QDoubleRectangle methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 21:00'!
texture: t

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


QDoubleRectangle subclass: #QCarpet
	instanceVariableNames: 'mouseStart shiftPressed selectedFrame selectedPoint selectedAction boxPoint basePosition baseLength '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!QCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 23:37'!
defaultSize

	^ 5.0  "2.0"! !

!QCarpet methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 11:06'!
initialize

	super initialize.

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


TSpinner subclass: #QDragger
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!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/17/2005 22:05'!
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 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 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/20/2005 20:30' 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 direction.

!


!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:18'!
addCannonAt: position 


	|  c  |

	c_ QCannon meta new.
	c meta initializeWithPitch: self.
	c meta colorize: Color gray darker asB3DColor.

	c meta translation: position.

	self meta addChild: c.

	^c.! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:19'!
addCannonAt: position pointing: direction


	|  c  |

	c_ QCannon meta new.
	c meta initializeWithPitch: self.
	c meta colorize: Color gray darker asB3DColor.

	c meta translation: position.

	self meta addChild: c.

	^c.! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 18:57'!
addCarpets: n

	
	| carpet dragger z i |

z _ OrderedCollection new.
i _ 1.

(Color wheel: n) do: [ : color |
	carpet _ QCarpet meta new.
	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.
	self meta addChild: dragger.

	z add: carpet.

].

	^ 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/21/2005 21:18'!
addWalls

	| w z  txt |

	z _ OrderedCollection new: 4.

	" blue endzone "

	w _ QCarpet meta new.
	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 _ QCarpet meta new.
	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 _ QCarpet meta new.
		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 _ QCarpet meta new.
	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 _ QCarpet meta new.
	w objectName: 'floorCarpet'.
	w meta extent: xSize @ zSize.
	w meta rotationAroundX: 90.
	w meta translationX: xSize/2 y: 0.0 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/21/2005 20:14'!
configureBallFrequency

	^ 1.8! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:32'!
configureCannonDirection

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

	^ (B3DVector3 x: 7.7 y:0.1 z: 5.1) ! !

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

	^ 100.0! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 21:29'!
configureNumberBalls

	^ 42 ! !

!QPitch methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:14'!
configureNumberCarpets

	^ 8 ! !

!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/21/2005 00:05'!
initialize

	super initialize.

	futureList _ QFutureList new initialize.

	self length: self configureLengthOfPitch .

	carpets _ self addCarpets: self configureNumberCarpets.

	blueCannon _ self 
			addCannonAt: (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: -7.7 y:0.9 z: -5.1).
"

	walls _ self addWalls.

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




! !

!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/18/2005 21:58'!
step


	futureList sendAllMessagesBefore: TeaTime now asSeconds.
! !

!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/20/2005 23:07'!
spew2: aStringProducingBlock

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

	false
		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 ) ].! !


Object subclass: #QPlane
	instanceVariableNames: 'point normal box minX maxX minY maxY minZ maxZ '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 14:14'!
boundingBox

	^ box! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:11'!
computeMaxAndMin

	| a b |

	a_ box min.
	b_ box max.

	minX_ a x min: b x.
	maxX_ a x max: b x.

	minY_ a y min: b y.
	maxY_ a y max: b y.

	minZ_ a z min: b z.
	maxZ_ a z max: b z.
! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:12'!
maxX
	^maxX! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:12'!
maxY
	^maxY! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:12'!
maxZ
	^maxZ! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:11'!
minX
	^minX! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:11'!
minY
	^minY! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:12'!
minZ
	^minZ! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 15:48'!
normal

	^ normal! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 15:48'!
point

	^ point! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/18/2005 21:19'!
point: p normal: n boundingBox: b

	point_ p.
	normal_ n.
	box_ b.

	box ifNotNil: [ self computeMaxAndMin. ].
! !

!QPlane methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 22:31'!
printOn: aStream

	aStream nextPutAll: 'QPlane', self identityHash, '(center=', point, ',normal=', normal, 

			' X: ', minX, ' .. ', maxX,
			' Y: ', minY, ' .. ', maxY,
			' Z: ', minZ, ' .. ', maxZ,
		')'.! !


Object subclass: #QPlaneIntersection
	instanceVariableNames: 'when where willIntersect qplane '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Croquet-Q'!

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:56'!
epsilon

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

	^ 0.000001.    "about a microsecond or a micrometer"! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:28'!
intersect: pln withPointStartingPosition: p0 time: t0 velocity: v

	"	 (QPlaneIntersection new
			intersect: 	
				( QPlane new 
					point: (B3DVector3 x: 22.0 y: 0.02 z: 0.02) 
					normal: (B3DVector3 x: 1.0 y: 0.1 z: 0.1) normalize 
					boundingBox: nil 
				)
			withPointStartingPosition: (B3DVector3 x: -100.0 y: 0.0 z: 0.0)
			time: 1000.0 
			velocity: (B3DVector3 x: 8.0001 y: 0.0001 z: 0.0)
		) when. 

 1015.25029004965

 (QPlaneIntersection new
			intersect:	
				( QPlane new 
					point: (B3DVector3 x: 22.0 y: 0.02 z: 0.02) 
					normal: (B3DVector3 x: 1.0 y: 0.1 z: 0.1) normalize 
					boundingBox: nil 
				)
			withPointStartingPosition: (B3DVector3 x: -100.0 y: 0.0 z: 0.0)
			time: 1000.0 
			velocity: (B3DVector3 x: 8.0001 y: 0.0001 z: 0.0)
		) where. 

a B3DVector3(22.00384521484375 0.001525028957985342 0.0)

 (QPlaneIntersection new
			intersect: 	
				( QPlane new 
					point: (B3DVector3 x: 22.0 y: 0.02 z: 0.02) 
					normal: (B3DVector3 x: 1.0 y: 0.1 z: 0.1) normalized negated
					boundingBox: nil 
				)
			withPointStartingPosition: (B3DVector3 x: -100.0 y: 0.0 z: 0.0)
			time: 1000.0 
			velocity: (B3DVector3 x: 8.0001 y: 0.0001 z: 0.0)
		) when. 


 (QPlaneIntersection new
			intersect: 	
				( QPlane new 
					point: (B3DVector3 x: 22.0 y: 0.02 z: 0.02) 
					normal: (B3DVector3 x: 1.0 y: 0.1 z: 0.1) normalized negated
					boundingBox: nil 
				)
			withPointStartingPosition: (B3DVector3 x: -100.0 y: 0.0 z: 0.0)
			time: 1000.0 
			velocity: (B3DVector3 x: 8.0001 y: 0.0001 z: 0.0)
		) where. 


@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
	"


			
			

	|  numerator  denominator  parellel  |

	qplane _ pln.

QPitch spew: [ 'plane ', qplane, ' p0 ', p0, ' v ', v ].


	willIntersect _ false.
	when _ where _ nil.  " initially, in case they are parellel "

	"p1 _ p0 + v.   point at time t0 + 1 :  v is distance in 1 second "

	denominator _ qplane normal dot: v.

"888 frob."

	parellel _ denominator abs < self epsilon.

	parellel ifTrue: [ ^self ]. "return because no intersecton"


	numerator _ qplane normal dot: qplane point-p0.

	when _ t0 + (numerator / denominator).
	where _ p0 + ((when-t0) * v).

QPitch spew: [ 'numerator ', numerator, ' / denominator ', denominator, ' = ', (numerator / denominator) ].

QPitch spew: [ 'now ', t0, ' when-now ', (when-t0), ' where ', where ].

	" epsilon prevents events from happening again, due to rounding errors "
	willIntersect _ (when > (t0 + self epsilon) ).  " true if intersection is in future "

	willIntersect ifTrue: [ qplane boundingBox ifNotNil: [

		" must further refine that it will intersect in the box -- epsilon helps exact test cases "

		willIntersect _ 
		((((( qplane minX - self epsilon <= where x ) and:
		[ qplane maxX + self epsilon >= where x ]) and:
		[ qplane minY - self epsilon <= where y ]) and:
		[ qplane maxY + self epsilon >= where y ]) and:
		[ qplane minZ - self epsilon <= where z ]) and:
		[ qplane maxZ + self epsilon >= where z ] .


willIntersect ifTrue: [
QPitch spew2: [ 'qplane normal=', (qplane normal) ].
QPitch spew2: [ 'qplane point=', (qplane point) ].
QPitch spew2: [ 'p0=', (p0) ].
QPitch spew2: [ 'qplane point-p0=', (qplane point-p0) ].
QPitch spew2: [ 'qplane normal dot: qplane point-p0=', ((qplane normal) dot: (qplane point-p0)) ].
QPitch spew2: [ '      ... / denom =', ( ((qplane normal) dot: (qplane point-p0)) / denominator ) ].
QPitch spew2: [ 'numerator=', numerator, ' / denominator=', denominator, ' ->', (numerator / denominator) ].

QPitch spew2: [ 'now=', t0, ' when-now=', (when-t0), ' when= ', when, ' where=', where ].
QPitch spew2: [ 'INTERSECT: when ', when, ' where ', where, ' with ', qplane, ' -> ', willIntersect ].
].

" qplane boundingBox,
		 ' { ', qplane boundingBox min, ' , ', qplane boundingBox max, ' } ',
		 ' -> ', willIntersect.	
"


	]].
		! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 21:46'!
printOn: aStream

	aStream nextPutAll: '{Collision when=' , ((when * 1000) asInteger), 'ms where=', where, '}'.
! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/21/2005 20:29'!
qplane

	^qplane! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 15:46'!
when
	
	^ when! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/17/2005 15:46'!
where

	^ where! !

!QPlaneIntersection methodsFor: 'as yet unclassified' stamp: 'strick 9/20/2005 20:57'!
willIntersect

	" true or false "

	^ willIntersect! !

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

This class had 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.

-- Sometimes carpets quit working, or balls leak outside the walls.  Dunno why.

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

-- Edges of carpets often don't reflect balls.  Try for the center.

-- Canon should not start firing balls until you click on it -- so that 
   the balls can be correctly synchronized in multiplayer.

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