[GOODIE] Texture-mapped spheresDuane Maxwell dmaxwell at entrypoint.comThu Feb 3 23:02:39 UTC 2000
Oops.
It turns out if you don't have the plug-in, there's a minor bug that Alan
Kay discovered (thanks!). I guess I got addicted to the plugin and didn't
notice this problem with the Smalltalk simulator.
There's an extra "bits" method call - you can attempt an execution and
elimiate the offending code and proceed, or you can just file-in the
enclosed changeset instead of the earlier one.
This only happens if the plugin isn't there, which, I must point out, is
rather important to making this thing remotely nifty.
>Change Set: Graphics-Sphere
>Date: 30 January 2000
>Author: Duane Maxwell
>
>This changeset implements high-speed texture-mapped spheres. While that
>might not seem very exciting, it's an interesting hack that illustrates the
>strengths of Squeak's plugins. It's also useful for those all-too-frequent
>times when you need to rotate Mars - hopefully the distribution includes
>the appropriate texture maps.
>
-------------- next part --------------
'From Squeak2.7 of 5 January 2000 [latest update: #1782] on 3 February 2000
at 2:58:54 pm'!
"Change Set: Graphics-Sphere
Date: 30 January 2000
Author: Duane Maxwell
This changeset implements high-speed texture-mapped spheres. While that
might not seem very exciting, it's an interesting hack that illustrates the
strengths of Squeak's plugins. It's also useful for those all-too-frequent
times when you need to rotate Mars - hopefully the distribution includes
the appropriate texture maps."!
Object subclass: #Sphere
instanceVariableNames: 'theta phi psi textureSize texture lookup map '
classVariableNames: 'Lookups Maps '
poolDictionaries: ''
category: 'Graphics-Sphere'!
Sphere class
instanceVariableNames: ''!
Morph subclass: #SphereMorph
instanceVariableNames: 'image sphere deltaTheta deltaPhi deltaPsi '
classVariableNames: 'InitialTexture '
poolDictionaries: ''
category: 'Graphics-Sphere'!
InterpreterPlugin subclass: #SpherePlugin
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-Sphere'!
!Sphere commentStamp: '<historical>' prior: 0!
This class produces the image of a texture-mapped sphere.
Textures must be of depth 32 and a power-of-two in dimensions, typically
256x256. Angles are expressed in texture pixels, not degrees or radians.
Submitted by Duane Maxwell
!
!Sphere methodsFor: 'drawing' stamp: 'DSM 2/3/2000 14:57'!
drawOn: aForm
| bounds center radius radius2 xRadius beta xCenter xIncrement
xScaled alpha map1 map2 theta1 phi1 psi1 |
aForm depth = 32 ifFalse: [ self error: 'Form must be depth 32'].
Sphere primPluginAvailable ifTrue: [
^ self primDrawOn: aForm ].
bounds _ 0 @ 0 extent: aForm extent.
center _ bounds center.
radius _ center x min: center y.
radius2 _ radius * radius.
theta1 _ theta \\ textureSize.
phi1 _ phi \\ textureSize.
psi1 _ psi \\ textureSize.
1 - radius to: radius - 1 do: [:y |
xRadius _ (radius2 - (y * y)) sqrt rounded asInteger.
xRadius = 0 ifTrue: [xRadius _ 1].
beta _ (map at: y + radius * textureSize / (2 * radius) +
1) * textureSize.
xCenter _ center y + y * bounds width + center x.
xIncrement _ ((textureSize bitShift: 16) / (2 * xRadius))
asInteger.
xScaled _ 0.
1 - xRadius to: xRadius - 1 do: [:x |
alpha _ (map at: (xScaled bitShift: -16) + 1) // 2
+ phi1.
map1 _ (lookup at: beta + alpha + 1) + theta1.
map1 > lookup size ifTrue: [map1 _ 0 ].
map2 _ (lookup at: map1 + 1) + psi1.
map2 > texture size ifTrue: [map2 _ 0].
aForm bits at: xCenter + x put: (texture at: map2 + 1).
xScaled _ xScaled + xIncrement]]! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 5/9/1999 21:02'!
phi
^ phi! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 1/31/2000 18:32'!
phi: angle
phi _ angle \\ textureSize! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 5/9/1999 21:02'!
psi
^ psi! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 1/31/2000 18:32'!
psi: angle
psi _ angle \\ textureSize! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:54'!
texture: aForm
"We want a 32-bit deep image with power-of-two dimensions"
aForm depth = 32 ifFalse: [ self error: 'Texture must be depth 32'].
aForm width isPowerOfTwo ifFalse: [ self error: 'Texture size must
be power of two'].
texture _ aForm bits asWordArray.
textureSize ~= aForm width ifTrue: [
textureSize _ aForm width.
lookup _ Sphere lookupForSize: textureSize.
map _ Sphere mapForSize: textureSize.
].
! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 5/9/1999 20:41'!
theta
^ theta! !
!Sphere methodsFor: 'accessing' stamp: 'DSM 1/31/2000 18:32'!
theta: angle
theta _ angle \\ textureSize! !
!Sphere methodsFor: 'primitives' stamp: 'DSM 1/30/2000 20:23'!
primDrawOn: aForm
self
primDrawOn: aForm bits
width: aForm width
height: aForm height
theta: theta asInteger
phi: phi asInteger
psi: psi asInteger
lookup: lookup
map: map
texture: texture
textureSize: textureSize asInteger.
! !
!Sphere methodsFor: 'primitives' stamp: 'DSM 1/30/2000 16:52'!
primDrawOn: dstBits width: w height: h theta: aTheta phi: aPhi psi: aPsi lookup: aLookup map: aMap texture: aTextureBits textureSize: aTextureSize
<primi
tive: 'primitiveSphereDraw' module: 'spherePrims'>
^ self primitiveFailed! !
!Sphere methodsFor: 'initialization' stamp: 'DSM 10/18/1999 20:38'!
initialize
textureSize _ -1.
theta _ 0. phi _ 0. psi _ 0! !
!Sphere class methodsFor: 'instance creation' stamp: 'DSM 10/18/1999 20:37'!
new
^ super new initialize! !
!Sphere class methodsFor: 'examples' stamp: 'DSM 2/3/2000 14:57'!
example
"
Sphere example
(not recommended without the plugin, but it will work)
"
| t s f d |
t _ Form extent: 128 @ 128 depth: 32.
t fillFromXYColorBlock: [:x :y |
d _ 1.0 - (x - 0.5) abs - (y - 0.5) abs.
Color r: d g: d sin b: 1.0 - d].
s _ Sphere new texture: t; theta: 0; phi: 0; psi: 0.
f _ Form extent: 256 @ 256 depth: 32.
0 to: 100 by: 6 do: [:i |
s phi: i asFloat.
s psi: (i * 3) asFloat.
s theta: i asFloat.
s drawOn: f.
f display.
Display forceDisplayUpdate].! !
!Sphere class methodsFor: 'utilities' stamp: 'DSM 2/3/2000 00:09'!
lookupForSize: textureSize
| yoffset alpha1 alpha2 beta1 beta2 cosBeta1 cosBeta2 xCartesian
yCartesian zCartesian size2 w pi sym lookup |
sym _ textureSize asString asSymbol.
lookup _ Lookups at: sym ifAbsent: [ nil ].
lookup ifNil:
[lookup _ WordArray new: textureSize + 1 * textureSize.
self primPluginAvailable
ifTrue: [ self primBuildLookup: lookup
textureSize: textureSize]
ifFalse:
[pi _ Float pi.
size2 _ textureSize * textureSize.
0 to: textureSize do:
[:y |
yoffset _ y * textureSize.
beta1 _ y - (textureSize /
2) * pi / textureSize.
yCartesian _ beta1 sin.
cosBeta1 _ beta1 cos.
0 to: textureSize - 1 do:
[:x |
alpha1 _ x * pi *
2.0 / textureSize.
zCartesian _ alpha1
sin * cosBeta1.
xCartesian _ alpha1
cos * cosBeta1.
beta2 _ xCartesian
arcSin.
cosBeta2 _ beta2 cos.
cosBeta2 = 0.0
ifTrue: [cosBeta2 _ 1.0e-6].
w _ zCartesian /
cosBeta2.
w >= 1.0 ifTrue: [w
_ 1.0].
w <= -1.0 ifTrue:
[w _ -1.0].
alpha2 _ w arcCos.
yCartesian /
cosBeta2 < 0.0 ifTrue: [alpha2 _ pi * 2.0 - alpha2].
lookup at: yoffset
+ x + 1 put:
(alpha2 *
textureSize / (2.0 * pi)) asInteger +
((beta2 *
textureSize / pi + (textureSize / 2)) asInteger *
textureSize) \\ size2
]]].
Lookups at: sym put: lookup].
^ lookup! !
!Sphere class methodsFor: 'utilities' stamp: 'DSM 2/3/2000 00:08'!
mapForSize: textureSize
| sym map pi |
sym _ textureSize asString asSymbol.
map _ Maps at: sym ifAbsent: [ nil ].
map ifNil: [
map _ WordArray new: textureSize * 2.
self primPluginAvailable
ifTrue: [ self primBuildMap: map textureSize:
textureSize ]
ifFalse: [
pi _ Float pi.
1 to: textureSize do: [ :x |
map at: x put:
((((x-(textureSize/2))*2/textureSize) arcCos)
*textureSize/pi) rounded asInteger \\ textureSize.
map at: (x+textureSize) put: (map
at: x)]].
Maps at: sym put: map].
^ map
! !
!Sphere class methodsFor: 'utilities' stamp: 'DSM 1/30/2000 19:12'!
primBuildLookup: aWordArray textureSize: anInteger
<primitive: 'primitiveSphereBuildLookup' module: 'spherePrims'>
^ self primitiveFailed! !
!Sphere class methodsFor: 'utilities' stamp: 'DSM 1/30/2000 19:08'!
primBuildMap: aWordArray textureSize: anInteger
<primitive: 'primitiveSphereBuildMap' module: 'spherePrims'>
^ self primitiveFailed! !
!Sphere class methodsFor: 'utilities' stamp: 'DSM 1/30/2000 19:15'!
primPluginAvailable
<primitive: 'primitiveSphereAvailable' module: 'spherePrims'>
^ false
! !
!Sphere class methodsFor: 'class initialization' stamp: 'DSM 2/3/2000 00:00'!
initialize
"
Sphere initialize
"
"These dictionaries allow various spheres to share the rather large
mapping
tables among themselves. Since they're weak, you can expect the tables
to be collected if no one's using them. They're keyed by texture
map size"
Maps _ WeakValueDictionary new.
Lookups _ WeakValueDictionary new! !
!SphereMorph commentStamp: '<historical>' prior: 0!
This morph displays a texture-mapped sphere. The texture ideally should be
square, 32 bits deep, and be a power-of-two in dimensions, though this will
be corrected if necessary by the accessor. You can also drag any morph
onto the sphere and its (static) image will be mapped.
The first sphere you make may take a few seconds - some internal tables get
built. From then on it gets faster to make things, though if you delete
all spheres and a garbage collection occurs, it may need to reinitialize
the tables. Check out the examples on the class side - if you have the
texture maps they look pretty cool. Two of the examples construct their
own texture maps - one in particular is based on the ubiquitous Pixar "Luxo
Jr" ball. The "planet" demos require some external maps.
There is a menu item that brings up a crude control panel to control the
rotation of the sphere. I also strongly recommend you have the plugin -
the computation are painfully slow without it.
Submitted by Duane Maxwell
!
!SphereMorph reorganize!
('initialization' initialize)
('drawing' drawOn:)
('stepping' step stepTime wantsSteps)
('private' buildImage)
('menus' addCustomMenuItems:hand: makeControls: minusPhi minusPsi
minusTheta plusPhi plusPsi plusTheta reset)
('dropping/grabbing' acceptDroppingMorph:event: wantsDroppedMorph:event:)
('accessing' deltaPhi deltaPhi: deltaPsi deltaPsi: deltaTheta deltaTheta:
extent: phi phi: psi psi: texture: theta theta:)
!
!SphereMorph methodsFor: 'initialization' stamp: 'DSM 1/31/2000 18:41'!
initialize
super initialize.
sphere _ Sphere new.
self texture: SphereMorph initialTexture.
sphere theta: 64; phi: 128.
deltaTheta _ 0.
deltaPhi _ 1.
deltaPsi _ 0! !
!SphereMorph methodsFor: 'drawing' stamp: 'DSM 1/30/2000 18:09'!
drawOn: aCanvas
aCanvas image: image at: bounds origin.
! !
!SphereMorph methodsFor: 'stepping' stamp: 'DSM 1/30/2000 18:13'!
step
sphere theta: (sphere theta + deltaTheta).
sphere phi: (sphere phi + deltaPhi).
sphere psi: (sphere psi + deltaPsi).
self buildImage! !
!SphereMorph methodsFor: 'stepping' stamp: 'DSM 1/30/2000 18:12'!
stepTime
^ 0! !
!SphereMorph methodsFor: 'stepping' stamp: 'DSM 1/30/2000 18:11'!
wantsSteps
^ true! !
!SphereMorph methodsFor: 'private' stamp: 'DSM 1/30/2000 20:19'!
buildImage
((image isNil) or: [image extent ~= self extent]) ifTrue: [
image _ Form extent: self extent depth: 32].
sphere drawOn: image.
self changed
! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 19:04'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
aCustomMenu add: 'make controls...' action: #makeControls:.! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 2/2/2000 23:01'!
makeControls: evt
| c a b |
c _ AlignmentMorph new orientation: #vertical.
c borderColor: Color blue; borderWidth: 5.
c addMorphBack: (a _ AlignmentMorph new orientation: #horizontal).
a addMorphBack: (b _ SimpleButtonMorph new label: 'X').
b target: c; actionSelector: #delete.
a addMorphBack: (b _ SimpleButtonMorph new label: 'reset').
b target: self; actionSelector: #reset.
c addMorphBack: (a _ AlignmentMorph new orientation: #horizontal).
a addMorphBack: (b _ SimpleButtonMorph new label: '+').
b target: self; actionSelector: #plusTheta.
a addMorphBack: (b _ SimpleButtonMorph new label: 'stop').
b target: self; actionSelector: #deltaTheta:; arguments: {0}.
a addMorphBack: (b _ SimpleButtonMorph new label: '-').
b target: self; actionSelector: #minusTheta.
a addMorphBack: (StringMorph contents: 'theta').
c addMorphBack: (a _ AlignmentMorph new orientation: #horizontal).
a addMorphBack: (b _ SimpleButtonMorph new label: '+').
b target: self; actionSelector: #plusPhi.
a addMorphBack: (b _ SimpleButtonMorph new label: 'stop').
b target: self; actionSelector: #deltaPhi:; arguments: {0}.
a addMorphBack: (b _ SimpleButtonMorph new label: '-').
b target: self; actionSelector: #minusPhi.
a addMorphBack: (StringMorph contents: 'phi').
c addMorphBack: (a _ AlignmentMorph new orientation: #horizontal).
a addMorphBack: (b _ SimpleButtonMorph new label: '+').
b target: self; actionSelector: #plusPsi.
a addMorphBack: (b _ SimpleButtonMorph new label: 'stop').
b target: self; actionSelector: #deltaPsi:; arguments: {0}.
a addMorphBack: (b _ SimpleButtonMorph new label: '-').
b target: self; actionSelector: #minusPsi.
a addMorphBack: (StringMorph contents: 'psi').
"c openInWorld"
evt hand attachMorph: c! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:21'!
minusPhi
self deltaPhi: self deltaPhi - 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:22'!
minusPsi
self deltaPsi: self deltaPsi - 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:21'!
minusTheta
self deltaTheta: self deltaTheta - 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:22'!
plusPhi
self deltaPhi: self deltaPhi + 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:22'!
plusPsi
self deltaPsi: self deltaPsi + 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:21'!
plusTheta
self deltaTheta: self deltaTheta + 1! !
!SphereMorph methodsFor: 'menus' stamp: 'DSM 1/31/2000 18:23'!
reset
self theta: 0.
self phi: 0.
self psi: 0.
self deltaTheta: 0.
self deltaPhi: 0.
self deltaPsi: 0.
self changed! !
!SphereMorph methodsFor: 'dropping/grabbing' stamp: 'DSM 2/3/2000 12:21'!
acceptDroppingMorph: aMorph event: evt
| srcForm |
(aMorph respondsTo: #form)
ifTrue: [ srcForm _ aMorph form ]
ifFalse: [ srcForm _ aMorph imageForm ].
self texture: srcForm.
! !
!SphereMorph methodsFor: 'dropping/grabbing' stamp: 'DSM 1/31/2000 18:04'!
wantsDroppedMorph: aMorph event: evt
^ true! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaPhi
^ deltaPhi! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaPhi: anAngle
deltaPhi _ anAngle! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaPsi
^ deltaPsi! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaPsi: anAngle
deltaPsi _ anAngle! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaTheta
^ deltaTheta! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:51'!
deltaTheta: anAngle
deltaTheta _ anAngle! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:52'!
extent: aPoint
| m |
m _ aPoint x min: aPoint y.
super extent: m at m.
self buildImage! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
phi
^ sphere phi! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
phi: anAngle
sphere phi: anAngle! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
psi
^ sphere psi! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
psi: anAngle
sphere psi: anAngle! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 2/3/2000 12:22'!
texture: aForm
| srcBounds dstBounds dstForm warp |
(aForm depth = 32
and: [aForm width = aForm height
and: [aForm width > 2 and: [aForm width
isPowerOfTwo]]])
ifTrue: [sphere texture: aForm]
ifFalse:
[srcBounds _ 0 @ 0 extent: aForm extent - (1 @ 1).
dstBounds _ 0 @ 0 corner: 256 @ 256.
dstForm _ Form extent: dstBounds extent depth: 32.
warp _ WarpBlt toForm: dstForm.
warp cellSize: 2;
clipRect: dstBounds;
sourceForm: aForm;
combinationRule: Form over.
warp copyQuad: srcBounds corners toRect: dstBounds.
sphere texture: dstForm].
self buildImage! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
theta
^ sphere theta! !
!SphereMorph methodsFor: 'accessing' stamp: 'DSM 1/31/2000 17:50'!
theta: anAngle
sphere theta: anAngle! !
!SphereMorph class reorganize!
('misc' initialTexture)
('examples' earth luxoBall mars moon test)
!
!SphereMorph class methodsFor: 'misc' stamp: 'DSM 2/2/2000 23:53'!
initialTexture
| yy xx |
InitialTexture
ifNil:
[InitialTexture _ Form extent: 256 @ 256 depth: 32.
InitialTexture fillFromXYColorBlock:
[:x :y |
yy _ 1 - (y - 0.5 * 2) abs. "mirror
hemispheres"
yy _ (yy * 7) asInteger.
xx _ (x * (1 bitShift: yy)) asInteger.
y < 0.5
ifTrue: [xx odd
ifTrue: [Color red]
ifFalse: [Color orange]]
ifFalse: [xx even
ifTrue: [Color blue]
ifFalse: [Color green]]]].
^ InitialTexture! !
!SphereMorph class methodsFor: 'examples' stamp: 'DSM 1/31/2000 17:52'!
earth
"
SphereMorph earth
"
| s |
Cursor wait showWhile: [
s _ SphereMorph new extent: 100 at 100.
s texture: (Form fromBMPFileNamed: 'EarthTexture.bmp')].
s openInWorld! !
!SphereMorph class methodsFor: 'examples' stamp: 'DSM 2/3/2000 00:09'!
luxoBall
"Make some Luxo bait....
SphereMorph luxoBall
"
| s tex yy xx curve innerPoint outerPoint |
Cursor wait
showWhile:
[curve _ 0.25 . "coefficient for quadratic polynomial"
innerPoint _ 0.2 .
outerPoint _ 0.5 .
tex _ Form extent: 256 @ 256 depth: 32.
tex fillFromXYColorBlock:
[:x :y |
yy _ 1 - (y - 0.5 * 2) abs. "mirror
hemispheres"
yy > 0.8
ifTrue: [Color r: 0.2 g:
0.2 b: 1.0 "blue" ]
ifFalse:
[xx _ (x * 5)
fractionPart. "five points"
xx _ 1 - (xx - 0.5
* 2) abs. "points are symmetric"
xx _
((2-(4*curve))*xx*xx) + ((4*curve-1)*xx). "follow curve"
yy _
(yy-innerPoint)/(outerPoint-innerPoint).
xx > yy
ifTrue:
[Color r: 0.9 g: 0 b: 0 "red"]
ifFalse:
[Color r: 0.9 g: 0.9 b: 0.2 "yellow"]]].
s _ SphereMorph new extent: 100 @ 100.
s texture: tex. s deltaTheta: 1].
s openInWorld
! !
!SphereMorph class methodsFor: 'examples' stamp: 'DSM 1/31/2000 17:53'!
mars
"
SphereMorph mars
"
| s |
Cursor wait showWhile: [
s _ SphereMorph new extent: 100 at 100.
s texture: (Form fromBMPFileNamed: 'MarsTexture.bmp')].
s openInWorld! !
!SphereMorph class methodsFor: 'examples' stamp: 'DSM 1/31/2000 17:53'!
moon
"
SphereMorph moon
"
| s |
Cursor wait showWhile: [
s _ SphereMorph new extent: 100 at 100.
s texture: (Form fromBMPFileNamed: 'MoonTexture.bmp')].
s openInWorld! !
!SphereMorph class methodsFor: 'examples' stamp: 'DSM 1/31/2000 17:53'!
test
"
SphereMorph test
"
| s |
Cursor wait showWhile: [ s _ SphereMorph new extent: 100 at 100].
s openInWorld! !
!SpherePlugin commentStamp: '<historical>' prior: 0!
This plugin accelerates the creation and rendering of texture-mapped spheres.
It wants to be named "SpherePlugin", with module name "spherePrims"
Submitted by Duane Maxwell!
!SpherePlugin reorganize!
('primitives' primitiveSphereAvailable primitiveSphereBuildLookup
primitiveSphereBuildMap primitiveSphereDraw)
('support' buildLookup:textureSize: buildMap:textureSize: checkedWordPtrOf:
drawOn:width:height:theta:phi:psi:lookup:map:texture:textureSize:)
!
!SpherePlugin methodsFor: 'primitives' stamp: 'DSM 1/30/2000 17:11'!
primitiveSphereAvailable
self export: true.
interpreterProxy pop: 1.
interpreterProxy pushBool: true! !
!SpherePlugin methodsFor: 'primitives' stamp: 'DSM 1/30/2000 16:47'!
primitiveSphereBuildLookup
"p1 (s1) is WordArray[textureSize*(textureSize+1)]"
"p2 (s0) is textureSize"
| lookup textureSize |
self export: true.
self var: 'lookup' declareC: 'unsigned long *lookup'.
interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy
primitiveFail].
textureSize _ interpreterProxy stackIntegerValue: 0.
lookup _ self checkedWordPtrOf: (interpreterProxy stackObjectValue: 1).
interpreterProxy failed ifTrue: [ ^ interpreterProxy primitiveFail ].
self buildLookup: lookup textureSize: textureSize.
interpreterProxy pop: 2! !
!SpherePlugin methodsFor: 'primitives' stamp: 'DSM 1/30/2000 16:47'!
primitiveSphereBuildMap
"p1 (s1) is WordArray[textureSize*2]"
"p2 (s0) is textureSize"
| map textureSize |
self export: true.
self var: 'map' declareC: 'unsigned long *map'.
interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy
primitiveFail].
textureSize _ interpreterProxy stackIntegerValue: 0.
map _ self checkedWordPtrOf: (interpreterProxy stackObjectValue: 1).
interpreterProxy failed ifTrue: [^interpreterProxy primitiveFail ].
self buildMap: map textureSize: textureSize.
interpreterProxy pop: 2! !
!SpherePlugin methodsFor: 'primitives' stamp: 'DSM 1/30/2000 16:48'!
primitiveSphereDraw
"p1 (s9) is WordArray[w*h] -- the destination bitmap"
"p2 (s8) is w -- width of bitmap in pixels (long)"
"p3 (s7) is h -- height of the bitmap (long)"
"p4 (s6) is theta - the angle around the vertical axis"
"p5 (s5) is phi - another angle around some axis"
"p6 (s4) is psi - another angle around some axis"
"p7 (s3) is WordArray - the lookup table built by another primitive"
"p8 (s2) is WordArray - the map built by another table"
"p9 (s1) is WordArray - the texture map"
"p10 (s0) is textureSize - the size of the texture"
| lookup textureSize textureBits map psi phi theta h w dstBits |
self export: true.
self var: 'lookup' declareC: 'unsigned long *lookup'.
self var: 'map' declareC: 'unsigned long *map'.
self var: 'dstBits' declareC: 'unsigned long *dstBits'.
self var: 'textureBits' declareC: 'unsigned long *textureBits'.
interpreterProxy methodArgumentCount = 10
ifFalse:[^interpreterProxy primitiveFail].
textureSize _ interpreterProxy stackIntegerValue: 0.
textureBits _ self checkedWordPtrOf: (interpreterProxy
stackObjectValue: 1).
map _ self checkedWordPtrOf: (interpreterProxy stackObjectValue: 2).
lookup _ self checkedWordPtrOf: (interpreterProxy stackObjectValue: 3).
psi _ interpreterProxy stackIntegerValue: 4.
phi _ interpreterProxy stackIntegerValue: 5.
theta _ interpreterProxy stackIntegerValue: 6.
h _ interpreterProxy stackIntegerValue: 7.
w _ interpreterProxy stackIntegerValue: 8.
dstBits _ self checkedWordPtrOf: (interpreterProxy
stackObjectValue: 9).
interpreterProxy failed ifTrue: [ ^ interpreterProxy primitiveFail ].
self drawOn: dstBits width: w height: h theta: theta phi: phi psi:
psi lookup: lookup map: map texture: textureBits textureSize: textureSize.
interpreterProxy pop: 2! !
!SpherePlugin methodsFor: 'support' stamp: 'DSM 1/30/2000 16:27'!
buildLookup: lookup textureSize: textureSize
| yoffset alpha1 alpha2 beta1 beta2 cosBeta1 cosBeta2 xCartesian
yCartesian zCartesian size2 w pi |
self var: 'lookup' declareC: 'unsigned long *lookup'.
self var: 'pi' declareC: 'double pi'.
self var: 'alpha1' declareC: 'double alpha1'.
self var: 'alpha2' declareC: 'double alpha2'.
self var: 'beta1' declareC: 'double beta1'.
self var: 'beta2' declareC: 'double beta2'.
self var: 'cosBeta1' declareC: 'double cosBeta1'.
self var: 'cosBeta2' declareC: 'double cosBeta2'.
self var: 'xCartesian' declareC: 'double xCartesian'.
self var: 'yCartesian' declareC: 'double yCartesian'.
self var: 'zCartesian' declareC: 'double zCartesian'.
self var: 'w' declareC: 'double w'.
pi _ 3.141592653589793.
size2 _ textureSize * textureSize.
0 to: textureSize do: [:y |
yoffset _ y * textureSize.
beta1 _ (y - (textureSize / 2)) * pi / textureSize.
yCartesian _ beta1 sin.
cosBeta1 _ beta1 cos.
0 to: textureSize - 1 do: [:x |
alpha1 _ x * pi * 2.0 / textureSize.
zCartesian _ alpha1 sin * cosBeta1.
xCartesian _ alpha1 cos * cosBeta1.
beta2 _ xCartesian asin.
cosBeta2 _ beta2 cos.
cosBeta2 = 0.0 ifTrue: [cosBeta2 _ 1.0e-6].
w _ zCartesian / cosBeta2.
w >= 1.0 ifTrue: [w _ 1.0].
w <= -1.0 ifTrue: [w _ -1.0].
alpha2 _ w acos.
yCartesian / cosBeta2 < 0.0 ifTrue: [alpha2 _ pi *
2.0 - alpha2].
lookup
at: yoffset + x
put: (alpha2 * textureSize / (2.0 * pi) "+
0.5") asInteger
+ ((beta2 * textureSize / pi +
(textureSize / 2) "+ 0.5") asInteger
* textureSize) \\ size2]]! !
!SpherePlugin methodsFor: 'support' stamp: 'DSM 1/30/2000 17:41'!
buildMap: map textureSize: textureSize
| pi |
self var: 'map' declareC: 'unsigned long *map'.
self var: 'pi' declareC: 'double pi'.
pi _ 3.141592653589793.
1 to: textureSize do: [ :x |
map at: x-1 put: (((((x-(textureSize/ 2.0 ))* 2.0 /
textureSize) acos)*textureSize/pi) +0.5) asInteger \\ textureSize.
map at: (x+textureSize-1) put: (map at: x-1)
]
! !
!SpherePlugin methodsFor: 'support' stamp: 'DSM 1/30/2000 16:22'!
checkedWordPtrOf: oop
"Return the first indexable word of oop which is assumed to be
variableWordSubclass"
self returnTypeC:'unsigned long *'.
interpreterProxy success: (interpreterProxy isWords: oop).
interpreterProxy failed ifTrue:[^0].
^self cCoerce: (interpreterProxy firstIndexableField: oop)
to:'unsigned long *'! !
!SpherePlugin methodsFor: 'support' stamp: 'DSM 1/30/2000 18:56'!
drawOn: dstBits width: w height: h theta: theta phi: phi psi: psi lookup:
lookup map: map texture: textureBits textureSize: textureSize
| centerX centerY radius radius2 xRadius beta xCenter xIncrement
xScaled alpha map1 map2 theta1 phi1 psi1 |
self var: 'dstBits' declareC: 'unsigned long *dstBits'.
self var: 'textureBits' declareC: 'unsigned long *textureBits'.
self var: 'lookup' declareC: 'unsigned long *lookup'.
self var: 'map' declareC: 'unsigned long *map'.
self var: 'radius2' declareC: 'double radius2'.
self var: 'xCenter' declareC: 'unsigned long *xCenter'.
centerX _ w // 2.
centerY _ h // 2.
centerX>centerY ifTrue: [radius _ centerY] ifFalse: [radius _ centerX].
radius2 _ radius * radius.
theta1 _ theta \\ textureSize.
phi1 _ phi \\ textureSize.
psi1 _ psi \\ textureSize.
1 - radius to: radius - 1 do: [:y |
xRadius _ ((radius2 - (y * y)) sqrt + 0.5) asInteger.
xRadius = 0 ifTrue: [xRadius _ 1].
beta _ (map at: y + radius * textureSize / (2 * radius)) *
textureSize.
xCenter _ dstBits + ((centerY + y) * w) + centerX.
xIncrement _ ((textureSize << 16) / (2 * xRadius)) asInteger.
xScaled _ 0.
1 - xRadius to: xRadius - 1 do: [:x |
alpha _ (map at: xScaled >> 16) // 2 + phi1.
map1 _ (lookup at: beta + alpha) + theta1.
map2 _ (lookup at: map1) + psi1.
xCenter at: x put: (textureBits at: map2).
xScaled _ xScaled + xIncrement]]
! !
!SpherePlugin class reorganize!
('translation' moduleName)
!
!SpherePlugin class methodsFor: 'translation' stamp: 'DSM 1/30/2000 15:44'!
moduleName
"
SpherePlugin translateDoInlining: true
"
^ 'Sphere'! !
Sphere initialize!
-------------- next part --------------
===================================================
Duane Maxwell dmaxwell (at) entrypoint.com
CTO http://www.entrypoint.com
EntryPoint, Inc. (858)348-3040 FAX(858)348-3100
Information contained herein is my personal opinion
and not necessarily that of EntryPoint.
===================================================
More information about the Squeak-dev mailing list |