{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, PatternSignatures #-} ---------------------------------------------------------------------- -- | -- Module : Graphics.SceneGraph.Library -- Copyright : (c) Mark Wassell 2008 -- License : LGPL -- -- Maintainer : mwassell@bigpond.net.au -- Stability : experimental -- Portability : portable -- -- ---------------------------------------------------------------------- module Graphics.SceneGraph.Library where import Graphics.Rendering.OpenGL (GLdouble) import Data.Graph.Inductive.Graph import Control.Monad.Identity import Control.Monad import Graphics.SceneGraph.Basic import Graphics.SceneGraph.Vector -- | osgt = runIdentity . osg simple1 :: (SceneGraph,Node) simple1 = osgt $ torus 0.5 `colour` Red simple :: (SceneGraph,Node) simple = osgt d where d = do let ring = torus 0.5 `colour` Red axial1 = cube 0.5 `scale` v1x 40 `colour` Green axial2 = cube 0.5 `scale` v1z 40 `colour` Green ring `translate` vy 2 <+> ring `translate` vy (-2) <+> axial1 `translate` vy (-3) <+> axial2 `translate` vy 3 rr :: GLdouble rr = 5 crossbeam :: GLdouble -> OSG SceneNode crossbeam t = cube 0.5 `colour` Red `scale` v1y 8 `translate` vector3 ((rr*2) * (sin t)) 0 ( (rr*2) * (cos t)) crossbeams' (t:[]) = crossbeam t crossbeams' (t:ts) = let n' = crossbeams' ts in (crossbeam t) <+> n' crossbeams = crossbeams' [(2*pi*i/8) | i <- [0..7] ] ferris :: GLdouble -> OSG SceneNode ferris theta = do let ring = torus 0.5 `colour` White --Blue axial1 = cube 0.5 `scale` v1x 40 `colour` Green axial2 = cube 0.5 `scale` v1z 40 `colour` Green axial = axial1 <+> axial2 root <- (strip <+> ring `translate` vy 2 <+> ring `translate` vy (-2) <+> axial `translate` vy (-2) <+> axial `translate` vy 2 <+> crossbeams) `rotate` (theta , (vector3 0 1 0 )) return root -- Blue is the bit the user clicks/drags -- Red is the 'border' -- Yellow/Green is the rest -- FIXME - The centre of the wheel also switchs to white ?? wheel :: OSG SceneNode wheel = do let ring = torus 0.5 `colour` Red axial = cube 0.5 `scale` v1x 40 `colour` Green ( simple_button 0.75 `colour` Blue <*> vz 10 <+> sphere 1 <+> ring <+> axial <+> axial `rotateY` 45 <+> axial `rotateY` 90 <+> axial `rotateY` 135) `scaleS` 0.1 buttons :: OSG SceneNode buttons = do let snum = 101 switch2 = switch' snum btn1 = (sphere 1 `colour` Red) `switch` (sphere 1 `colour` White) btn2 = (sphere 1 `colour` Green) `switch` (sphere 1 `colour` White) b_blue = btn1 `handler` switchHandler b_green = btn2 `handler` switchHandler b_colour = (sphere 1 `colour` Blue) `switch2` (sphere 1 `colour` Green) b_blue <+> b_green <*> vz 10 <+> b_colour `translate` vz 20 <+> light <*> vz 15 <+> camera <*> (vy (-10)) simple_button s = (sphere s `colour` Blue) `switch` (sphere s `colour` White) button = simple_button 0.5 `handler` switchHandler <*> vy (-0.15) <+> cube 0.5 `colour` Green (vector3 2.5 1.2 2.5) <+> torus 1 `scaleS` 0.05 `colour` Red <*> vy (-0.3) sqButton = ((cube 0.4 `colour`) Blue `switch` (cube 0.4 `colour` White)) `handler` switchHandler <*> vy (-0.15) <+> cube 0.5 `colour` Green textBox = text "Hello World" `scaleS` 0.02 `colour` White slider = simple_button 0.17 `handler2` (switchHandler,dragHandler) vector3 1 1 1.2 <*> vy (-0.2) <+> cube 0.5 `colour` Green (vector3 8 1.2 2) <+> torus 2 (vector3 0.15 0.02 0.02) `colour` Red <*> vy (-0.3) tux :: OSG SceneNode tux = let sphere' a x y z = sphere a vector3 x y z body = sphere' 1 0.95 1 0.8 `colour` Black <+> sphere' 1 0.8 0.9 0.7 `colour` White <*> vector3 0 0 0.17 torso = body `scaleS` 0.9 (shoulders::OSG SceneNode) = (leftArm <+> rightArm <+> body `scaleS` 0.72 ) <*> vector3 0 0.4 0.05 neck = head <*> vector3 0 0.9 0.07 <+> sphere' 0.8 0.45 0.5 0.45 `colour` Black `rotateY` 90 <+> sphere' 0.66 0.8 0.9 0.7 `colour` White <*> (vector3 0 (-0.08) 0.35) (head::OSG SceneNode) = (beak <+> eyes <+> sphere' 1 0.42 0.5 0.42 `colour` Black `rotateY` 90 ) <*> (vector3 0 0.3 0.07) beak = sphere' 0.8 0.23 0.12 0.4 `colour` Yellow `rotateX` 10 <*> (vector3 0 (-0.205) 0.3) <+> sphere' 0.66 0.21 0.17 0.38 `colour` Yellow `rotateX` 10 <*> (vector3 0 (-0.23) 0.3) eyes = leftEye <+> leftIris <+> rightEye <+> rightIris leftEye = sphere' 0.66 0.1 0.13 0.03 `colour` White <*> (vector3 0.13 (-0.03) 0.38) leftIris = sphere' 0.66 0.055 0.07 0.03 `colour` Yellow <*> (vector3 0.12 (-0.045) 0.4) rightEye = leftEye <*> (vx (-0.26)) rightIris = leftIris <*> (vx (-0.26)) leftForeArm = leftHand <+> sphere' 0.66 0.3 0.07 0.15 `colour` Black <*> vx (-0.23) leftHand = sphere' 0.5 0.12 0.05 0.12 leftArm = (leftForeArm <+> sphere' 0.66 0.34 0.1 0.2 `colour` Black ) `rotateX` 90 `rotateZ` 45 <*> vector3 (-0.56) 0.3 0 `rotateY` 180 rightArm = sphere 0.1 hipBall = sphere' 0.5 0.09 0.18 0.09 `colour` Black calf = (foot <+> sphere' 1 0.06 0.18 0.06 `colour` Yellow) `rotateY` 90 <*> (vector3 0 (-0.21) 0) foot = (footBase <+> toe1 <+> toe2 ) `colour` Yellow (vector3 1.1 1.0 1.3) footBase = sphere' 0.66 0.25 0.08 0.18 toe1 = sphere' 0.66 0.27 0.07 0.11 `rotateY` 30 <*> (vector3 (-0.07) 0 0.1) toe2 = sphere' 0.66 0.27 0.07 0.11 (thigh::OSG SceneNode) = (hipBall <+> calf <+> sphere' 0.5 0.07 0.3 0.07 `colour` Yellow <*> (vector3 0 (-0.1) 0) `rotateY` (-110) ) `rotateY` 110 <*> (vector3 (-0.28) (-0.8) 0) `rotateY` 180 (tail::OSG SceneNode) = sphere' 0.5 0.2 0.3 0.1 `colour` Black <*> (vector3 0 0.15 0) `rotateX` (-60) <*> (vector3 0 (-0.4) (-0.5)) in torso <+> shoulders <+> neck <+> thigh <+> thigh <+> tail tuxAndToys :: Scene tuxAndToys = osgt $ tux `rotateZ` (0) `rotateY` (0) `rotateX` 90 <*> vz 1.1 <+> wheel <*> vector3 2 0 1 <+> button <*> vector3 4 0 2.2 <+> button <*> vector3 4 0 1 <+> slider <*> vector3 7 0 1 <+> textBox <*> vector3 2 0 3 <+> plane 10 `colour` LightBlue <*> vector3 (-5) (-5) 0 <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3 sliderScene = osgt $ slider <*> vector3 7 0 1 <+> plane 10 `colour` LightBlue <*> vector3 (-5) (-5) 0 <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3 {-- scene3 = osgt $ addNodeBasic buttonMesh `colour` Blue `scaleS` 50 <*> vector3 (-125) (75) 0 <+> addNodeBasic mesh1 `colour` Blue `scaleS` 1 <*> vector3 (-125) (75) 0 <+> addNodeBasic mesh2 `colour` Blue `scaleS` 1 <*> vector3 (-125) (75) 0 <+> addNodeBasic mesh3 `colour` Blue `scaleS` 1 <*> vector3 (-125) (75) 0 <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3 --} emptyScene = osgt $ plane 10 `colour` LightBlue `rotateX` 90 <*> vector3 (-5) (10) 0 <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3 --scene3 = osgt $ -- scene3 = osgt $ addNodeBasic `colour` Blue `scaleS` 1 <*> vector3 (-125) (75) 0 -- <+> light <*> vz 20 -- <+> camera <*> vector3 (-4) 0 3 sceneSlider = osgt $ slider <+> textBox <*> vector3 2 0 3 <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3 sceneButton = osgt $ button `label` "btn1" <+> textBox `label` "txt" <*> vector3 2 0 3 <+> light <*> vz 20 <+> camera <*> vector3 0 (-10) 0 calcButton :: [Char] -> OSGT Identity SceneNode calcButton txt = sqButton `label` ("btn" ++ txt) <+> (text txt `scaleS` 0.002 <*> vector3 (-0.1) (-0.4) (-0.2)) room' tWall tFloor tCeiling size = let wall txt = plane 1 `texture` txt vector3 (size) (size) 1 hs = size/2 in (wall tFloor <*> vector3 (-hs) hs 0 <+> wall tCeiling <*> vector3 (-hs) hs size <+> wall tWall `rotateZ` 90 `rotateY` 90 <*> vector3 hs (-hs) size <+> wall tWall `rotateZ` 90 `rotateY` 90 <*> vector3 (-hs) (-hs) size <+> wall tWall `rotateX` 90 <*> vector3 (-hs) hs size ) room :: OSGT Identity SceneNode room = room' "oldbrk_01" "oldstone2" "oldstone2grooved" 40 calculator :: Scene calculator = osgt $ (calcButton "1" <+> calcButton "2" <*> vector3 1 0 0 <+> calcButton "3" <*> vector3 2 0 0 <+> calcButton "4" <*> vector3 0 0 1 <+> calcButton "5" <*> vector3 1 0 1 <+> calcButton "6" <*> vector3 2 0 1 <+> calcButton "7" <*> vector3 0 0 2 <+> calcButton "8" <*> vector3 1 0 2 <+> calcButton "9" <*> vector3 2 0 2 <+> calcButton "0" <*> vector3 0 0 3 <+> calcButton "c" <*> vector3 1 0 3 <+> calcButton "+" <*> vector3 2 0 3 <+> calcButton "=" <*> vector3 3 0 3 <+> cube 1 vector3 5 1 5 <*> vector3 2 0.3 2 `colour` LightBlue <+> cube 1 vector3 5 1 2 <*> vector3 2 0.3 5.5 `colour` Black <+> textBox `label` "txt" `scaleS` 0.3 <*> vector3 (0.0) (-0.4) 5) `rotateX` (-70) <*> vector3 0 0 8 <+> cylinder 4 5 `texture` "oldstone2_bas01" `rotateX` 90 <*> vector3 0 0 5 <+> room <+> light <*> vz 20 <+> camera <*> vector3 0 (-10) 15 console = osgt $ button `label` "btn1" <*> vector3 0 0 0 <+> button `label` "btn2" <*> vector3 2 0 0 <+> button `label` "btn3" <*> vector3 4 0 0 <+> button `label` "btn4" <*> vector3 6 0 0 <+> button `label` "btn5" <*> vector3 8 0 0 <+> slider `label` "RdSlider" <*> vector3 1.2 0 (-1.5) <+> slider `label` "GrSlider" <*> vector3 1.2 0 (-3.0) <+> slider `label` "BlSlider" <*> vector3 1.2 0 (-4.5) <+> slider `label` "ItSlider" <*> vector3 5.0 0 (-1.5) <+> slider `label` "BmSlider" <*> vector3 5.0 0 (-3.0) <+> slider `label` "XSlider" <*> vector3 5.0 0 (-4.5) <+> slider `label` "YSlider" `rotateY` 90 <*> vector3 8.0 0 (-3.5) <+> light <*> vz 20 <+> camera <*> vector3 (-4) 0 3