-
Notifications
You must be signed in to change notification settings - Fork 4
/
Sample_09_Skybox.hs
63 lines (49 loc) · 1.7 KB
/
Sample_09_Skybox.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
{-# LANGUAGE OverloadedStrings #-}
module Sample_09_Skybox where
import HGamer3D
import Control.Concurrent
import Control.Monad
import SampleRunner
camy c d = do
updateC c ctOrientation (\u -> (rotU vec3Y d) .*. u)
updateC c ctPosition (\p -> rotate3 d vec3Y p)
rotateWorld c quitV = do
camy c 0.002
sleepFor (msecT 20)
q <- readVar quitV
if not q
then rotateWorld c quitV
else return ()
creator hg3d c = do
eGeo <- newE hg3d [
ctGeometry #: ShapeGeometry Cube,
ctMaterial #: matWoodTiles,
ctScale #: Vec3 8.0 8.0 8.0,
ctPosition #: Vec3 0.0 0.0 0.0,
ctOrientation #: unitU
]
sky <- newE hg3d [
ctSkybox #: SkyboxMaterial "Materials/Skybox.xml"
]
quitV <- makeVar False
let rotateCube = do
updateC eGeo ctOrientation (\u -> (rotU vec3Z 0.02) .*. u)
sleepFor (msecT 12)
q <- readVar quitV
if not q
then rotateCube
else return ()
forkIO rotateCube
forkIO $ rotateWorld c quitV
return (c, eGeo, sky, quitV)
destructor (c, eGeo, sky, quitV) = do
writeVar quitV True
sleepFor (msecT 500) -- monitor that cube stops before deletion
delE eGeo
delE sky
setC c ctOrientation unitU
setC c ctPosition (Vec3 1.0 1.0 (-30.0))
return ()
sampleRunner hg3d c = SampleRunner (return ()) (do
state <- creator hg3d c
return (SampleRunner (destructor state) (return emptySampleRunner) ))