'From VisualWorks® NonCommercial, 7.6 of March 3, 2008 on February 27, 2009 at 1:53:23 am'! "Package AoBench*"! Smalltalk defineClass: #Sphere superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: 'center radius ' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! Smalltalk defineClass: #Vec superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: 'x y z ' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! Smalltalk defineClass: #Ray superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: 'origin direction ' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! Smalltalk defineClass: #AoBench superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: '' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! Smalltalk defineClass: #Isect superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: 't hit p n ' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! Smalltalk defineClass: #Plane superclass: #{Core.Object} indexedType: #none private: false instanceVariableNames: 'p n ' classInstanceVariableNames: '' imports: '' category: 'Category-AoBench'! !Sphere class methodsFor: 'instance creation'! center: center radius: radius ^self new setCenter: center radius: radius; yourself! ! !Sphere methodsFor: 'private'! setCenter: newCenter radius: newRadius center := newCenter. radius := newRadius! ! !Sphere methodsFor: 'accessing'! center ^center! radius ^radius! ! !Sphere methodsFor: 'calculating'! intersectRay: ray isect: isect | rs b c d | rs := ray origin - center. b := rs dot: ray direction. c := (rs dot: rs) - (radius * radius). d := b * b - c. d > 0.0 ifTrue: [ | t | t := b negated - d sqrt. (t > 0.0 and: [t < isect t]) ifTrue: [ isect t: t. isect hit: true. isect p: ray origin + (ray direction * t). isect n: (isect p - center) normalize]]! ! !Plane class methodsFor: 'instance creation'! p: p n: n ^self new setP: p n: n; yourself! ! !Plane methodsFor: 'calculating'! intersectRay: ray isect: isect | d v t | d := (p dot: n) negated. v := ray direction dot: n. v abs < 1.0e-17 ifTrue: [^false]. t := ((ray origin dot: n) + d) negated / v. (t > 0.0 and: [t < isect t]) ifTrue: [ isect hit: true. isect t: t. isect n: n. isect p: ray origin + (ray direction * t)]! ! !Plane methodsFor: 'private'! setP: newP n: newN p := newP. n := newN! ! !Ray class methodsFor: 'instance creation'! origin: origin direction: direction ^self new setOrigin: origin direction: direction; yourself! ! !Ray methodsFor: 'private'! setOrigin: newOri direction: newDir origin := newOri. direction := newDir! ! !Ray methodsFor: 'accessing'! direction ^direction! origin ^origin! ! !Isect class methodsFor: 'instance creation'! new ^super new initialize; yourself! ! !Isect methodsFor: 'accessing'! p: aVec p := aVec! n ^n! hit: aBoolean hit := aBoolean! p ^p! t ^t! n: aVec n := aVec! t: aFloat t := aFloat! hit ^hit! ! !Isect methodsFor: 'initialization'! initialize t := 1000000.0. hit := false. p := Vec zero. n := Vec zero! ! !Isect methodsFor: 'calculating'! ambientOcclusion: scene samples: naoSamples | basis ntheta nphi eps occlution rand p1 | basis := Array new: 3. n orthoBasis: basis. ntheta := nphi := naoSamples. eps := 0.0001. occlution := 0.0. rand := Random new. p1 := p + (n * eps). nphi * ntheta timesRepeat: [ | r phi x y z rx ry rz raydir ray occIsect | r := rand next. phi := 2.0 * Float pi * rand next. x := phi cos * (1.0 - r) sqrt. y := phi sin * (1.0 - r) sqrt. z := r sqrt. rx := (x * (basis at: 1) x) + (y * (basis at: 2) x) + (z * (basis at: 3) x). ry := (x * (basis at: 1) y) + (y * (basis at: 2) y) + (z * (basis at: 3) y). rz := (x * (basis at: 1) z) + (y * (basis at: 2) z) + (z * (basis at: 3) z). raydir := Vec x: rx y: ry z: rz. ray := Ray origin: p1 direction: raydir. occIsect := Isect new. scene do: [:elem | elem intersectRay: ray isect: occIsect]. occIsect hit ifTrue: [occlution := occlution + 1.0]]. occlution := (ntheta * nphi - occlution) / (ntheta * nphi). ^Vec x: occlution y: occlution z: occlution! ! !Vec class methodsFor: 'instance creation'! x: x y: y z: z ^self new setX: x y: y z: z; yourself! zero ^self x: 0.0 y: 0.0 z: 0.0! ! !Vec methodsFor: 'accessing'! z ^z! length ^(x squared + y squared + z squared) sqrt! y ^y! x: newX x := newX! y: newY y := newY! z: newZ z := newZ! x ^x! ! !Vec methodsFor: 'arithmetic'! * n ^Vec x: x * n y: y * n z: z * n! - aVec ^Vec x: x - aVec x y: y - aVec y z: z - aVec z! / n ^Vec x: x / n y: y / n z: z / n! cross: aVec ^ Vec x: y * aVec z - (z * aVec y) y: z * aVec x - (x * aVec z) z: x * aVec y - (y * aVec x)! + aVec ^Vec x: x + aVec x y: y + aVec y z: z + aVec z! dot: aVec ^(x * aVec x) + (y * aVec y) + (z * aVec z)! ! !Vec methodsFor: 'converting'! orthoBasis: basis basis at: 3 put: self copy. basis at: 2 put: Vec zero. (x between: -0.6 and: 0.6) ifTrue: [(basis at: 2) x: 1.0] ifFalse: [(y between: -0.6 and: 0.6) ifTrue: [(basis at: 2) y: 1.0] ifFalse: [(z between: -0.6 and: 0.6) ifTrue: [(basis at: 2) z: 1.0] ifFalse: [(basis at: 2) x: 1.0]]]. basis at: 1 put: ((basis at: 2) cross: (basis at: 3)). basis at: 1 put: (basis at: 1) normalize. basis at: 2 put: ((basis at: 3) cross: (basis at: 1)). basis at: 2 put: (basis at: 2) normalize! normalize | length | length := self length. length > 1.0e-17 ifTrue: [^self / length]. ^self! ! !Vec methodsFor: 'private'! setX: newX y: newY z: newZ x := newX. y := newY. z := newZ! ! !AoBench class methodsFor: 'utility methods'! clamp: f | i | i := f * 255.5. i > 255.0 ifTrue: [i := 255.0]. i < 0.0 ifTrue: [i := 0.0]. ^i rounded! ! !AoBench class methodsFor: 'benchmark'! render "Time millisecondsToRun: [AoBench render]" | out scene width height nsubSamples naoSamples cnt rgb lf | width := 256. height := 256. nsubSamples := 2. naoSamples := 8. out := 'ao.ppm' asFilename writeStream. lf := String with: Character lf. out nextPutAll: 'P6', lf. out nextPutAll: width printString, ' ', height printString, lf. out nextPutAll: '255', lf; binary. scene := (Array with: (Vec x: -2.0 y: 0.0 z: -3.5) with: (Vec x: -0.5 y: 0.0 z: -3.0) with: (Vec x: 1.0 y: 0.0 z: -2.2)) collect: [:vec | Sphere center: vec radius: 0.5]. scene := scene copyWith: (Plane p: (Vec x: 0.0 y: -0.5 z: 0.0) n: (Vec x: 0.0 y: 1.0 z: 0.0)). cnt := 0. 0 to: height - 1 do: [:y | 0 to: width - 1 do: [:x | | rad | rad := Vec zero. 0 to: nsubSamples - 1 do: [:v | 0 to: nsubSamples - 1 do: [:u | | px py eye ray isect | cnt := cnt + 1. px := (x + (u / nsubSamples) - (width / 2.0)) / (width / 2.0). py := (y + (v / nsubSamples) - (height / 2.0)) negated / (height / 2.0). eye := (Vec x: px y: py z: -1.0) normalize. ray := Ray origin: Vec zero direction: eye. isect := Isect new. scene do: [:elem | elem intersectRay: ray isect: isect]. isect hit ifTrue: [ | col | col := isect ambientOcclusion: scene samples: naoSamples. rad := rad + col]]]. rgb := rad / nsubSamples squared. out nextPut: (self clamp: rgb x). out nextPut: (self clamp: rgb y). out nextPut: (self clamp: rgb z)]]. out close! !