{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# Language StandaloneDeriving #-}
{-# Language DeriveFunctor #-}
{-# Language DeriveGeneric #-}
{-# Language TypeSynonymInstances #-}
module Vis.VisObject ( VisObject(..)
, drawObjects
, LoadedObjModel(..)
, loadObjModel
, setPerspectiveMode
, Euler(..)
) where
import GHC.Generics ( Generic )
import Control.Monad ( when )
import qualified Data.Binary as B
import qualified Data.Foldable as F
import Data.Maybe ( fromJust, isJust )
import Data.Vector.Binary ()
import qualified Data.Vector.Storable as VS
import Data.Word ( Word8 )
import Graphics.GL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.UI.GLUT as GLUT
import Graphics.UI.GLUT ( BitmapFont(..), Capability(..), Color4(..), Face(..)
, Flavour(..), MatrixMode(..), PrimitiveMode(..), Size(..)
, Vertex3(..), Vector3(..)
, ($=)
)
import Linear (V3(..),Quaternion,M33,fromQuaternion)
import qualified Vis.GlossColor as GlossColor
data Euler a = Euler { forall a. Euler a -> a
eYaw :: a
, forall a. Euler a -> a
ePitch :: a
, forall a. Euler a -> a
eRoll :: a
} deriving (Euler a -> Euler a -> Bool
(Euler a -> Euler a -> Bool)
-> (Euler a -> Euler a -> Bool) -> Eq (Euler a)
forall a. Eq a => Euler a -> Euler a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Euler a -> Euler a -> Bool
== :: Euler a -> Euler a -> Bool
$c/= :: forall a. Eq a => Euler a -> Euler a -> Bool
/= :: Euler a -> Euler a -> Bool
Eq, Int -> Euler a -> ShowS
[Euler a] -> ShowS
Euler a -> String
(Int -> Euler a -> ShowS)
-> (Euler a -> String) -> ([Euler a] -> ShowS) -> Show (Euler a)
forall a. Show a => Int -> Euler a -> ShowS
forall a. Show a => [Euler a] -> ShowS
forall a. Show a => Euler a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Euler a -> ShowS
showsPrec :: Int -> Euler a -> ShowS
$cshow :: forall a. Show a => Euler a -> String
show :: Euler a -> String
$cshowList :: forall a. Show a => [Euler a] -> ShowS
showList :: [Euler a] -> ShowS
Show, (forall a b. (a -> b) -> Euler a -> Euler b)
-> (forall a b. a -> Euler b -> Euler a) -> Functor Euler
forall a b. a -> Euler b -> Euler a
forall a b. (a -> b) -> Euler a -> Euler b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Euler a -> Euler b
fmap :: forall a b. (a -> b) -> Euler a -> Euler b
$c<$ :: forall a b. a -> Euler b -> Euler a
<$ :: forall a b. a -> Euler b -> Euler a
Functor, Eq (Euler a)
Eq (Euler a) =>
(Euler a -> Euler a -> Ordering)
-> (Euler a -> Euler a -> Bool)
-> (Euler a -> Euler a -> Bool)
-> (Euler a -> Euler a -> Bool)
-> (Euler a -> Euler a -> Bool)
-> (Euler a -> Euler a -> Euler a)
-> (Euler a -> Euler a -> Euler a)
-> Ord (Euler a)
Euler a -> Euler a -> Bool
Euler a -> Euler a -> Ordering
Euler a -> Euler a -> Euler a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Euler a)
forall a. Ord a => Euler a -> Euler a -> Bool
forall a. Ord a => Euler a -> Euler a -> Ordering
forall a. Ord a => Euler a -> Euler a -> Euler a
$ccompare :: forall a. Ord a => Euler a -> Euler a -> Ordering
compare :: Euler a -> Euler a -> Ordering
$c< :: forall a. Ord a => Euler a -> Euler a -> Bool
< :: Euler a -> Euler a -> Bool
$c<= :: forall a. Ord a => Euler a -> Euler a -> Bool
<= :: Euler a -> Euler a -> Bool
$c> :: forall a. Ord a => Euler a -> Euler a -> Bool
> :: Euler a -> Euler a -> Bool
$c>= :: forall a. Ord a => Euler a -> Euler a -> Bool
>= :: Euler a -> Euler a -> Bool
$cmax :: forall a. Ord a => Euler a -> Euler a -> Euler a
max :: Euler a -> Euler a -> Euler a
$cmin :: forall a. Ord a => Euler a -> Euler a -> Euler a
min :: Euler a -> Euler a -> Euler a
Ord, (forall x. Euler a -> Rep (Euler a) x)
-> (forall x. Rep (Euler a) x -> Euler a) -> Generic (Euler a)
forall x. Rep (Euler a) x -> Euler a
forall x. Euler a -> Rep (Euler a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Euler a) x -> Euler a
forall a x. Euler a -> Rep (Euler a) x
$cfrom :: forall a x. Euler a -> Rep (Euler a) x
from :: forall x. Euler a -> Rep (Euler a) x
$cto :: forall a x. Rep (Euler a) x -> Euler a
to :: forall x. Rep (Euler a) x -> Euler a
Generic)
instance B.Binary a => B.Binary (Euler a)
dcmOfQuat :: Num a => Quaternion a -> M33 a
dcmOfQuat :: forall a. Num a => Quaternion a -> M33 a
dcmOfQuat Quaternion a
q = V3 a -> V3 a -> V3 a -> V3 (V3 a)
forall a. a -> a -> a -> V3 a
V3
(a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
m11 a
m21 a
m31)
(a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
m12 a
m22 a
m32)
(a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
m13 a
m23 a
m33)
where
V3
(V3 a
m11 a
m12 a
m13)
(V3 a
m21 a
m22 a
m23)
(V3 a
m31 a
m32 a
m33) = Quaternion a -> V3 (V3 a)
forall a. Num a => Quaternion a -> M33 a
fromQuaternion Quaternion a
q
glColorOfColor :: GlossColor.Color -> Color4 GLfloat
glColorOfColor :: Color -> Color4 Float
glColorOfColor = (\(Float
r,Float
g,Float
b,Float
a) -> (Float -> Float) -> Color4 Float -> Color4 Float
forall a b. (a -> b) -> Color4 a -> Color4 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> Float -> Float -> Float -> Color4 Float
forall a. a -> a -> a -> a -> Color4 a
Color4 Float
r Float
g Float
b Float
a)) ((Float, Float, Float, Float) -> Color4 Float)
-> (Color -> (Float, Float, Float, Float)) -> Color -> Color4 Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> (Float, Float, Float, Float)
GlossColor.rgbaOfColor
setColor :: GlossColor.Color -> IO ()
setColor :: Color -> IO ()
setColor = Color4 Float -> IO ()
forall a. Color a => a -> IO ()
GLUT.color (Color4 Float -> IO ())
-> (Color -> Color4 Float) -> Color -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Color4 Float
glColorOfColor
setMaterialDiffuse :: GlossColor.Color -> IO ()
setMaterialDiffuse :: Color -> IO ()
setMaterialDiffuse Color
col = Face -> StateVar (Color4 Float)
GLUT.materialDiffuse Face
Front StateVar (Color4 Float) -> Color4 Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar (Color4 Float) -> Color4 Float -> m ()
$= (Color -> Color4 Float
glColorOfColor Color
col)
data VisObject a = VisObjects [VisObject a]
| Trans (V3 a) (VisObject a)
| RotQuat (Quaternion a) (VisObject a)
| RotDcm (M33 a) (VisObject a)
| RotEulerRad (Euler a) (VisObject a)
| RotEulerDeg (Euler a) (VisObject a)
| Scale (a,a,a) (VisObject a)
| Cylinder (a,a) GlossColor.Color
| Box (a,a,a) Flavour GlossColor.Color
| Cube a Flavour GlossColor.Color
| Sphere a Flavour GlossColor.Color
| Ellipsoid (a,a,a) Flavour GlossColor.Color
| Line (Maybe a) [V3 a] GlossColor.Color
| Line' (Maybe a) [(V3 a,GlossColor.Color)]
| Arrow (a,a) (V3 a) GlossColor.Color
| Axes (a,a)
| Plane (V3 a) GlossColor.Color GlossColor.Color
| Triangle (V3 a) (V3 a) (V3 a) GlossColor.Color
| Quad (V3 a) (V3 a) (V3 a) (V3 a) GlossColor.Color
| Text3d String (V3 a) BitmapFont GlossColor.Color
| Text2d String (a,a) BitmapFont GlossColor.Color
| Points [V3 a] (Maybe GLfloat) GlossColor.Color
| ObjModel LoadedObjModel GlossColor.Color
deriving ((forall x. VisObject a -> Rep (VisObject a) x)
-> (forall x. Rep (VisObject a) x -> VisObject a)
-> Generic (VisObject a)
forall x. Rep (VisObject a) x -> VisObject a
forall x. VisObject a -> Rep (VisObject a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (VisObject a) x -> VisObject a
forall a x. VisObject a -> Rep (VisObject a) x
$cfrom :: forall a x. VisObject a -> Rep (VisObject a) x
from :: forall x. VisObject a -> Rep (VisObject a) x
$cto :: forall a x. Rep (VisObject a) x -> VisObject a
to :: forall x. Rep (VisObject a) x -> VisObject a
Generic, (forall a b. (a -> b) -> VisObject a -> VisObject b)
-> (forall a b. a -> VisObject b -> VisObject a)
-> Functor VisObject
forall a b. a -> VisObject b -> VisObject a
forall a b. (a -> b) -> VisObject a -> VisObject b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> VisObject a -> VisObject b
fmap :: forall a b. (a -> b) -> VisObject a -> VisObject b
$c<$ :: forall a b. a -> VisObject b -> VisObject a
<$ :: forall a b. a -> VisObject b -> VisObject a
Functor)
data LoadedObjModel = LoadedObjModel (VS.Vector Double) (VS.Vector Double) Int deriving ((forall x. LoadedObjModel -> Rep LoadedObjModel x)
-> (forall x. Rep LoadedObjModel x -> LoadedObjModel)
-> Generic LoadedObjModel
forall x. Rep LoadedObjModel x -> LoadedObjModel
forall x. LoadedObjModel -> Rep LoadedObjModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoadedObjModel -> Rep LoadedObjModel x
from :: forall x. LoadedObjModel -> Rep LoadedObjModel x
$cto :: forall x. Rep LoadedObjModel x -> LoadedObjModel
to :: forall x. Rep LoadedObjModel x -> LoadedObjModel
Generic)
instance B.Binary LoadedObjModel
toFlavour :: Bool -> Flavour
toFlavour :: Bool -> Flavour
toFlavour Bool
False = Flavour
Solid
toFlavour Bool
True = Flavour
Wireframe
fromFlavour :: Flavour -> Bool
fromFlavour :: Flavour -> Bool
fromFlavour Flavour
Solid = Bool
False
fromFlavour Flavour
Wireframe = Bool
True
instance B.Binary Flavour where
put :: Flavour -> Put
put = Bool -> Put
forall t. Binary t => t -> Put
B.put (Bool -> Put) -> (Flavour -> Bool) -> Flavour -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flavour -> Bool
fromFlavour
get :: Get Flavour
get = (Bool -> Flavour) -> Get Bool -> Get Flavour
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Flavour
toFlavour Get Bool
forall t. Binary t => Get t
B.get
fromBitmapFont :: BitmapFont -> Word8
fromBitmapFont :: BitmapFont -> Word8
fromBitmapFont BitmapFont
Fixed8By13 = Word8
0 :: Word8
fromBitmapFont BitmapFont
Fixed9By15 = Word8
1 :: Word8
fromBitmapFont BitmapFont
TimesRoman10 = Word8
2 :: Word8
fromBitmapFont BitmapFont
TimesRoman24 = Word8
3 :: Word8
fromBitmapFont BitmapFont
Helvetica10 = Word8
4 :: Word8
fromBitmapFont BitmapFont
Helvetica12 = Word8
5 :: Word8
fromBitmapFont BitmapFont
Helvetica18 = Word8
6 :: Word8
toBitmapFont :: Word8 -> BitmapFont
toBitmapFont :: Word8 -> BitmapFont
toBitmapFont Word8
0 = BitmapFont
Fixed8By13
toBitmapFont Word8
1 = BitmapFont
Fixed9By15
toBitmapFont Word8
2 = BitmapFont
TimesRoman10
toBitmapFont Word8
3 = BitmapFont
TimesRoman24
toBitmapFont Word8
4 = BitmapFont
Helvetica10
toBitmapFont Word8
5 = BitmapFont
Helvetica12
toBitmapFont Word8
6 = BitmapFont
Helvetica18
toBitmapFont Word8
k = String -> BitmapFont
forall a. HasCallStack => String -> a
error (String -> BitmapFont) -> String -> BitmapFont
forall a b. (a -> b) -> a -> b
$ String
"deserializing BitmapFont got bad value (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance B.Binary BitmapFont where
put :: BitmapFont -> Put
put = Word8 -> Put
forall t. Binary t => t -> Put
B.put (Word8 -> Put) -> (BitmapFont -> Word8) -> BitmapFont -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitmapFont -> Word8
fromBitmapFont
get :: Get BitmapFont
get = (Word8 -> BitmapFont) -> Get Word8 -> Get BitmapFont
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> BitmapFont
toBitmapFont Get Word8
forall t. Binary t => Get t
B.get
fromColor :: GlossColor.Color -> (Float,Float,Float,Float)
fromColor :: Color -> (Float, Float, Float, Float)
fromColor = Color -> (Float, Float, Float, Float)
GlossColor.rgbaOfColor
toColor :: (Float,Float,Float,Float) -> GlossColor.Color
toColor :: (Float, Float, Float, Float) -> Color
toColor (Float
r,Float
g,Float
b,Float
a) = Float -> Float -> Float -> Float -> Color
GlossColor.makeColor Float
r Float
g Float
b Float
a
instance B.Binary (GlossColor.Color) where
put :: Color -> Put
put = (Float, Float, Float, Float) -> Put
forall t. Binary t => t -> Put
B.put ((Float, Float, Float, Float) -> Put)
-> (Color -> (Float, Float, Float, Float)) -> Color -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> (Float, Float, Float, Float)
fromColor
get :: Get Color
get = ((Float, Float, Float, Float) -> Color)
-> Get (Float, Float, Float, Float) -> Get Color
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float, Float, Float) -> Color
toColor Get (Float, Float, Float, Float)
forall t. Binary t => Get t
B.get
instance B.Binary a => B.Binary (VisObject a)
setPerspectiveMode :: IO ()
setPerspectiveMode :: IO ()
setPerspectiveMode = do
(Position
_, Size GLsizei
w GLsizei
h) <- StateVar (Position, Size) -> IO (Position, Size)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
StateVar (Position, Size) -> m (Position, Size)
GLUT.get StateVar (Position, Size)
GLUT.viewport
StateVar MatrixMode
GLUT.matrixMode StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= MatrixMode
Projection
IO ()
GLUT.loadIdentity
GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
GLUT.perspective GLdouble
40 (GLsizei -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
w GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLsizei -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
h) GLdouble
0.1 GLdouble
1000
StateVar MatrixMode
GLUT.matrixMode StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= GLsizei -> MatrixMode
Modelview GLsizei
0
drawObjects :: VisObject GLdouble -> IO ()
drawObjects :: VisObject GLdouble -> IO ()
drawObjects VisObject GLdouble
objects = do
IO ()
setPerspectiveMode
VisObject GLdouble -> IO ()
drawObject VisObject GLdouble
objects
drawObject :: VisObject GLdouble -> IO ()
drawObject :: VisObject GLdouble -> IO ()
drawObject (VisObjects [VisObject GLdouble]
xs) = (VisObject GLdouble -> IO ()) -> [VisObject GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VisObject GLdouble -> IO ()
drawObject [VisObject GLdouble]
xs
drawObject (Trans (V3 GLdouble
x GLdouble
y GLdouble
z) VisObject GLdouble
visobj) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
GLUT.translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
x GLdouble
y GLdouble
z :: Vector3 GLdouble)
VisObject GLdouble -> IO ()
drawObject VisObject GLdouble
visobj
drawObject (RotQuat Quaternion GLdouble
quat VisObject GLdouble
visobj) = VisObject GLdouble -> IO ()
drawObject (M33 GLdouble -> VisObject GLdouble -> VisObject GLdouble
forall a. M33 a -> VisObject a -> VisObject a
RotDcm (Quaternion GLdouble -> M33 GLdouble
forall a. Num a => Quaternion a -> M33 a
dcmOfQuat Quaternion GLdouble
quat) VisObject GLdouble
visobj)
drawObject (RotDcm (V3 (V3 GLdouble
m00 GLdouble
m01 GLdouble
m02) (V3 GLdouble
m10 GLdouble
m11 GLdouble
m12) (V3 GLdouble
m20 GLdouble
m21 GLdouble
m22)) VisObject GLdouble
visobject) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
GLmatrix GLdouble
mat <- MatrixOrder -> [GLdouble] -> IO (GLmatrix GLdouble)
forall c.
MatrixComponent c =>
MatrixOrder -> [c] -> IO (GLmatrix c)
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> [c] -> IO (m c)
GLUT.newMatrix MatrixOrder
GLUT.ColumnMajor
[ GLdouble
m00, GLdouble
m01, GLdouble
m02, GLdouble
0
, GLdouble
m10, GLdouble
m11, GLdouble
m12, GLdouble
0
, GLdouble
m20, GLdouble
m21, GLdouble
m22, GLdouble
0
, GLdouble
0, GLdouble
0, GLdouble
0, GLdouble
1
]
:: IO (GLUT.GLmatrix GLdouble)
GLmatrix GLdouble -> IO ()
forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
m c -> IO ()
GLUT.multMatrix GLmatrix GLdouble
mat
VisObject GLdouble -> IO ()
drawObject VisObject GLdouble
visobject
drawObject (RotEulerRad Euler GLdouble
euler VisObject GLdouble
visobj) =
VisObject GLdouble -> IO ()
drawObject (VisObject GLdouble -> IO ()) -> VisObject GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ Euler GLdouble -> VisObject GLdouble -> VisObject GLdouble
forall a. Euler a -> VisObject a -> VisObject a
RotEulerDeg ((GLdouble -> GLdouble) -> Euler GLdouble -> Euler GLdouble
forall a b. (a -> b) -> Euler a -> Euler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GLdouble
180GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
forall a. Floating a => a
pi)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*) Euler GLdouble
euler) VisObject GLdouble
visobj
drawObject (RotEulerDeg (Euler GLdouble
yaw GLdouble
pitch GLdouble
roll) VisObject GLdouble
visobj) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
GLUT.rotate GLdouble
yaw (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 GLdouble
1)
GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
GLUT.rotate GLdouble
pitch (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
1 GLdouble
0)
GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
GLUT.rotate GLdouble
roll (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
1 GLdouble
0 GLdouble
0)
VisObject GLdouble -> IO ()
drawObject VisObject GLdouble
visobj
drawObject (Scale (GLdouble
sx,GLdouble
sy,GLdouble
sz) VisObject GLdouble
visobj) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.normalize StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GLUT.scale GLdouble
sx GLdouble
sy GLdouble
sz
VisObject GLdouble -> IO ()
drawObject VisObject GLdouble
visobj
StateVar Capability
GLUT.normalize StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
drawObject (Triangle (V3 GLdouble
x0 GLdouble
y0 GLdouble
z0) (V3 GLdouble
x1 GLdouble
y1 GLdouble
z1) (V3 GLdouble
x2 GLdouble
y2 GLdouble
z2) Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_TRIANGLES
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x0 GLdouble
y0 GLdouble
z0
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x1 GLdouble
y1 GLdouble
z1
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x2 GLdouble
y2 GLdouble
z2
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
drawObject (Quad (V3 GLdouble
x0 GLdouble
y0 GLdouble
z0) (V3 GLdouble
x1 GLdouble
y1 GLdouble
z1) (V3 GLdouble
x2 GLdouble
y2 GLdouble
z2) (V3 GLdouble
x3 GLdouble
y3 GLdouble
z3) Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Color -> IO ()
setColor Color
col
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_QUADS
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x0 GLdouble
y0 GLdouble
z0
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x1 GLdouble
y1 GLdouble
z1
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x2 GLdouble
y2 GLdouble
z2
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
x3 GLdouble
y3 GLdouble
z3
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Cylinder (GLdouble
height,GLdouble
radius) Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
let nslices :: Int
nslices = Int
10 :: Int
nstacks :: Int
nstacks = Int
10 :: Int
sinCosTable :: [(GLdouble, GLdouble)]
sinCosTable = (GLdouble -> (GLdouble, GLdouble))
-> [GLdouble] -> [(GLdouble, GLdouble)]
forall a b. (a -> b) -> [a] -> [b]
map (\GLdouble
q -> (GLdouble -> GLdouble
forall a. Floating a => a -> a
sin GLdouble
q, GLdouble -> GLdouble
forall a. Floating a => a -> a
cos GLdouble
q)) [GLdouble]
angles
where
angle :: GLdouble
angle = GLdouble
2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
forall a. Floating a => a
piGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nslices)
angles :: [GLdouble]
angles = [GLdouble] -> [GLdouble]
forall a. [a] -> [a]
reverse ([GLdouble] -> [GLdouble]) -> [GLdouble] -> [GLdouble]
forall a b. (a -> b) -> a -> b
$ (Int -> GLdouble) -> [Int] -> [GLdouble]
forall a b. (a -> b) -> [a] -> [b]
map ((GLdouble
angleGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*) (GLdouble -> GLdouble) -> (Int -> GLdouble) -> Int -> GLdouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
0..(Int
nslicesInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)]
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_TRIANGLE_FAN
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glNormal3d GLdouble
0 GLdouble
0 (-GLdouble
1)
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
0 GLdouble
0 GLdouble
0
((GLdouble, GLdouble) -> IO ()) -> [(GLdouble, GLdouble)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(GLdouble
s,GLdouble
c) -> GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d (GLdouble
cGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) (GLdouble
sGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) GLdouble
0) [(GLdouble, GLdouble)]
sinCosTable
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_TRIANGLE_FAN
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glNormal3d GLdouble
0 GLdouble
0 GLdouble
1
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d GLdouble
0 GLdouble
0 GLdouble
height
((GLdouble, GLdouble) -> IO ()) -> [(GLdouble, GLdouble)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(GLdouble
s,GLdouble
c) -> GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d (GLdouble
cGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) (GLdouble
sGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) GLdouble
height) ([(GLdouble, GLdouble)] -> [(GLdouble, GLdouble)]
forall a. [a] -> [a]
reverse [(GLdouble, GLdouble)]
sinCosTable)
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
let
zSteps :: [GLdouble]
zSteps = (Int -> GLdouble) -> [Int] -> [GLdouble]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> (Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
heightGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nstacks)) [Int
0..Int
nstacks]
drawSlice :: GLdouble -> GLdouble -> (GLdouble, GLdouble) -> m ()
drawSlice GLdouble
z0 GLdouble
z1 (GLdouble
s,GLdouble
c) = do
GLdouble -> GLdouble -> GLdouble -> m ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glNormal3d GLdouble
c GLdouble
s GLdouble
0
GLdouble -> GLdouble -> GLdouble -> m ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d (GLdouble
cGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) (GLdouble
sGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) GLdouble
z0
GLdouble -> GLdouble -> GLdouble -> m ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glVertex3d (GLdouble
cGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) (GLdouble
sGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
radius) GLdouble
z1
drawSlices :: (GLdouble, GLdouble) -> m ()
drawSlices (GLdouble
z0,GLdouble
z1) = do
GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_QUAD_STRIP
((GLdouble, GLdouble) -> m ()) -> [(GLdouble, GLdouble)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GLdouble -> GLdouble -> (GLdouble, GLdouble) -> m ()
forall {m :: * -> *}.
MonadIO m =>
GLdouble -> GLdouble -> (GLdouble, GLdouble) -> m ()
drawSlice GLdouble
z0 GLdouble
z1) [(GLdouble, GLdouble)]
sinCosTable
m ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
((GLdouble, GLdouble) -> IO ()) -> [(GLdouble, GLdouble)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GLdouble, GLdouble) -> IO ()
forall {m :: * -> *}. MonadIO m => (GLdouble, GLdouble) -> m ()
drawSlices ([(GLdouble, GLdouble)] -> IO ())
-> [(GLdouble, GLdouble)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [GLdouble] -> [GLdouble] -> [(GLdouble, GLdouble)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([GLdouble] -> [GLdouble]
forall a. HasCallStack => [a] -> [a]
init [GLdouble]
zSteps) ([GLdouble] -> [GLdouble]
forall a. HasCallStack => [a] -> [a]
tail [GLdouble]
zSteps)
drawObject (Sphere GLdouble
r Flavour
flav Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
Flavour -> Object -> IO ()
forall (m :: * -> *). MonadIO m => Flavour -> Object -> m ()
GLUT.renderObject Flavour
flav (GLdouble -> GLsizei -> GLsizei -> Object
GLUT.Sphere' (GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
r) GLsizei
20 GLsizei
20)
drawObject (Ellipsoid (GLdouble
sx,GLdouble
sy,GLdouble
sz) Flavour
flav Color
col) = VisObject GLdouble -> IO ()
drawObject (VisObject GLdouble -> IO ()) -> VisObject GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble, GLdouble, GLdouble)
-> VisObject GLdouble -> VisObject GLdouble
forall a. (a, a, a) -> VisObject a -> VisObject a
Scale (GLdouble
sx,GLdouble
sy,GLdouble
sz) (VisObject GLdouble -> VisObject GLdouble)
-> VisObject GLdouble -> VisObject GLdouble
forall a b. (a -> b) -> a -> b
$ GLdouble -> Flavour -> Color -> VisObject GLdouble
forall a. a -> Flavour -> Color -> VisObject a
Sphere GLdouble
1 Flavour
flav Color
col
drawObject (Box (GLdouble
dx,GLdouble
dy,GLdouble
dz) Flavour
flav Color
col) = VisObject GLdouble -> IO ()
drawObject (VisObject GLdouble -> IO ()) -> VisObject GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble, GLdouble, GLdouble)
-> VisObject GLdouble -> VisObject GLdouble
forall a. (a, a, a) -> VisObject a -> VisObject a
Scale (GLdouble
dx,GLdouble
dy,GLdouble
dz) (VisObject GLdouble -> VisObject GLdouble)
-> VisObject GLdouble -> VisObject GLdouble
forall a b. (a -> b) -> a -> b
$ GLdouble -> Flavour -> Color -> VisObject GLdouble
forall a. a -> Flavour -> Color -> VisObject a
Cube GLdouble
1 Flavour
flav Color
col
drawObject (Cube GLdouble
r Flavour
flav Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
Flavour -> Object -> IO ()
forall (m :: * -> *). MonadIO m => Flavour -> Object -> m ()
GLUT.renderObject Flavour
flav (GLdouble -> Object
GLUT.Cube (GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
r))
drawObject (Line Maybe GLdouble
width [V3 GLdouble]
path Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Color -> IO ()
setColor Color
col
Float
lineWidth0 <- StateVar Float -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar Float -> m Float
GLUT.get StateVar Float
GLUT.lineWidth
case Maybe GLdouble
width of
Just GLdouble
w -> StateVar Float
GLUT.lineWidth StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= GLdouble -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
w
Maybe GLdouble
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GLUT.renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (V3 GLdouble -> IO ()) -> [V3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(V3 GLdouble
x' GLdouble
y' GLdouble
z') -> Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
GLUT.vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x' GLdouble
y' GLdouble
z') [V3 GLdouble]
path
StateVar Float
GLUT.lineWidth StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= Float
lineWidth0
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Line' Maybe GLdouble
width [(V3 GLdouble, Color)]
pathcols) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Float
lineWidth0 <- StateVar Float -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar Float -> m Float
GLUT.get StateVar Float
GLUT.lineWidth
case Maybe GLdouble
width of
Just GLdouble
w -> StateVar Float
GLUT.lineWidth StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= GLdouble -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
w
Maybe GLdouble
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_LINE_STRIP
let f :: (V3 a, Color) -> IO ()
f (V3 a
xyz, Color
col) = do
let V3 Float
x Float
y Float
z = (a -> Float) -> V3 a -> V3 Float
forall a b. (a -> b) -> V3 a -> V3 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac V3 a
xyz
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
Float -> Float -> Float -> IO ()
forall (m :: * -> *). MonadIO m => Float -> Float -> Float -> m ()
glVertex3f Float
x Float
y Float
z
((V3 GLdouble, Color) -> IO ()) -> [(V3 GLdouble, Color)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (V3 GLdouble, Color) -> IO ()
forall {a}. Real a => (V3 a, Color) -> IO ()
f [(V3 GLdouble, Color)]
pathcols
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
StateVar Float
GLUT.lineWidth StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= Float
lineWidth0
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Plane (V3 GLdouble
x GLdouble
y GLdouble
z) Color
col1 Color
col2) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let normInv :: GLdouble
normInv = GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(GLdouble -> GLdouble
forall a. Floating a => a -> a
sqrt (GLdouble -> GLdouble) -> GLdouble -> GLdouble
forall a b. (a -> b) -> a -> b
$ GLdouble
xGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
x GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
yGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
y GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
zGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
z)
x' :: GLdouble
x' = GLdouble
xGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
normInv
y' :: GLdouble
y' = GLdouble
yGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
normInv
z' :: GLdouble
z' = GLdouble
zGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
normInv
r :: GLdouble
r = GLdouble
10
n :: GLdouble
n = GLdouble
5
eps :: GLdouble
eps = GLdouble
0.01
GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
GLUT.rotate ((GLdouble -> GLdouble
forall a. Floating a => a -> a
acos GLdouble
z')GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
180GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
forall a. Floating a => a
pi :: GLdouble) (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (-GLdouble
y') GLdouble
x' GLdouble
0)
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBegin GLenum
GL_QUADS
Color -> IO ()
setColor Color
col2
let r' :: Float
r' = GLdouble -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLdouble
r
Float -> Float -> Float -> IO ()
forall (m :: * -> *). MonadIO m => Float -> Float -> Float -> m ()
glVertex3f Float
r' Float
r' Float
0
Float -> Float -> Float -> IO ()
forall (m :: * -> *). MonadIO m => Float -> Float -> Float -> m ()
glVertex3f (-Float
r') Float
r' Float
0
Float -> Float -> Float -> IO ()
forall (m :: * -> *). MonadIO m => Float -> Float -> Float -> m ()
glVertex3f (-Float
r') (-Float
r') Float
0
Float -> Float -> Float -> IO ()
forall (m :: * -> *). MonadIO m => Float -> Float -> Float -> m ()
glVertex3f Float
r' (-Float
r') Float
0
IO ()
forall (m :: * -> *). MonadIO m => m ()
glEnd
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glDisable GLenum
GL_BLEND
let drawWithEps :: GLdouble -> IO ()
drawWithEps GLdouble
eps' = do
(VisObject GLdouble -> IO ()) -> [VisObject GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VisObject GLdouble -> IO ()
drawObject ([VisObject GLdouble] -> IO ()) -> [VisObject GLdouble] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[VisObject GLdouble]] -> [VisObject GLdouble]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ Maybe GLdouble -> [V3 GLdouble] -> Color -> VisObject GLdouble
forall a. Maybe a -> [V3 a] -> Color -> VisObject a
Line Maybe GLdouble
forall a. Maybe a
Nothing
[ GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 (-GLdouble
r) GLdouble
y0 GLdouble
eps'
, GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
r GLdouble
y0 GLdouble
eps'
] Color
col1
, Maybe GLdouble -> [V3 GLdouble] -> Color -> VisObject GLdouble
forall a. Maybe a -> [V3 a] -> Color -> VisObject a
Line Maybe GLdouble
forall a. Maybe a
Nothing
[ GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
x0 (-GLdouble
r) GLdouble
eps',
GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
x0 GLdouble
r GLdouble
eps'
] Color
col1
] | GLdouble
x0 <- [-GLdouble
r,-GLdouble
rGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+GLdouble
rGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
n..GLdouble
r], GLdouble
y0 <- [-GLdouble
r,-GLdouble
rGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+GLdouble
rGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
n..GLdouble
r]]
GLdouble -> IO ()
drawWithEps GLdouble
eps
GLdouble -> IO ()
drawWithEps (-GLdouble
eps)
GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
GL_BLEND
drawObject (Arrow (GLdouble
size, GLdouble
aspectRatio) (V3 GLdouble
x GLdouble
y GLdouble
z) Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let numSlices :: GLsizei
numSlices = GLsizei
8
numStacks :: GLsizei
numStacks = GLsizei
15
cylinderRadius :: GLdouble
cylinderRadius = GLdouble
0.5GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
sizeGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
aspectRatio
cylinderHeight :: GLdouble
cylinderHeight = GLdouble
size
coneRadius :: GLdouble
coneRadius = GLdouble
2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
cylinderRadius
coneHeight :: GLdouble
coneHeight = GLdouble
2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
coneRadius
rotAngle :: GLdouble
rotAngle = GLdouble -> GLdouble
forall a. Floating a => a -> a
acos(GLdouble
zGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(GLdouble -> GLdouble
forall a. Floating a => a -> a
sqrt(GLdouble
xGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
x GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
yGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
y GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
zGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
z) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
1e-15))GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
180GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
forall a. Floating a => a
pi :: GLdouble
rotAxis :: Vector3 GLdouble
rotAxis = GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (-GLdouble
y GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
1e-15) GLdouble
x GLdouble
0
GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
GLUT.rotate GLdouble
rotAngle Vector3 GLdouble
rotAxis
VisObject GLdouble -> IO ()
drawObject (VisObject GLdouble -> IO ()) -> VisObject GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble, GLdouble) -> Color -> VisObject GLdouble
forall a. (a, a) -> Color -> VisObject a
Cylinder (GLdouble
cylinderHeight, GLdouble
cylinderRadius) Color
col
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
GLUT.translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 GLdouble
cylinderHeight :: Vector3 GLdouble)
Flavour -> Object -> IO ()
forall (m :: * -> *). MonadIO m => Flavour -> Object -> m ()
GLUT.renderObject Flavour
Solid (GLdouble -> GLdouble -> GLsizei -> GLsizei -> Object
GLUT.Cone GLdouble
coneRadius GLdouble
coneHeight GLsizei
numSlices GLsizei
numStacks)
drawObject (Axes (GLdouble
size, GLdouble
aspectRatio)) = IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let xAxis :: VisObject GLdouble
xAxis = (GLdouble, GLdouble) -> V3 GLdouble -> Color -> VisObject GLdouble
forall a. (a, a) -> V3 a -> Color -> VisObject a
Arrow (GLdouble
size, GLdouble
aspectRatio) (GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
1 GLdouble
0 GLdouble
0) (Float -> Float -> Float -> Float -> Color
GlossColor.makeColor Float
1 Float
0 Float
0 Float
1)
yAxis :: VisObject GLdouble
yAxis = (GLdouble, GLdouble) -> V3 GLdouble -> Color -> VisObject GLdouble
forall a. (a, a) -> V3 a -> Color -> VisObject a
Arrow (GLdouble
size, GLdouble
aspectRatio) (GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
0 GLdouble
1 GLdouble
0) (Float -> Float -> Float -> Float -> Color
GlossColor.makeColor Float
0 Float
1 Float
0 Float
1)
zAxis :: VisObject GLdouble
zAxis = (GLdouble, GLdouble) -> V3 GLdouble -> Color -> VisObject GLdouble
forall a. (a, a) -> V3 a -> Color -> VisObject a
Arrow (GLdouble
size, GLdouble
aspectRatio) (GLdouble -> GLdouble -> GLdouble -> V3 GLdouble
forall a. a -> a -> a -> V3 a
V3 GLdouble
0 GLdouble
0 GLdouble
1) (Float -> Float -> Float -> Float -> Color
GlossColor.makeColor Float
0 Float
0 Float
1 Float
1)
VisObject GLdouble -> IO ()
drawObject (VisObject GLdouble -> IO ()) -> VisObject GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ [VisObject GLdouble] -> VisObject GLdouble
forall a. [VisObject a] -> VisObject a
VisObjects [VisObject GLdouble
xAxis, VisObject GLdouble
yAxis, VisObject GLdouble
zAxis]
drawObject (Text3d String
string (V3 GLdouble
x GLdouble
y GLdouble
z) BitmapFont
font Color
col) = IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Color -> IO ()
setColor Color
col
GLdouble -> GLdouble -> GLdouble -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLdouble -> GLdouble -> GLdouble -> m ()
glRasterPos3d GLdouble
x GLdouble
y GLdouble
z
BitmapFont -> String -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> String -> m ()
forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
GLUT.renderString BitmapFont
font String
string
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Text2d String
string (GLdouble
x,GLdouble
y) BitmapFont
font Color
col) = IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Color -> IO ()
setColor Color
col
StateVar MatrixMode
GLUT.matrixMode StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= MatrixMode
Projection
IO ()
GLUT.loadIdentity
(Position
_, Size GLsizei
w GLsizei
h) <- StateVar (Position, Size) -> IO (Position, Size)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
StateVar (Position, Size) -> m (Position, Size)
GLUT.get StateVar (Position, Size)
GLUT.viewport
GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
GLUT.ortho2D GLdouble
0 (GLsizei -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
w) GLdouble
0 (GLsizei -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
h)
StateVar MatrixMode
GLUT.matrixMode StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= GLsizei -> MatrixMode
Modelview GLsizei
0
IO ()
GLUT.loadIdentity
GLdouble -> GLdouble -> IO ()
forall (m :: * -> *). MonadIO m => GLdouble -> GLdouble -> m ()
glRasterPos2d GLdouble
x GLdouble
y
BitmapFont -> String -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> String -> m ()
forall (m :: * -> *). MonadIO m => BitmapFont -> String -> m ()
GLUT.renderString BitmapFont
font String
string
IO ()
setPerspectiveMode
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Vis.VisObject.Points [V3 GLdouble]
xyzs Maybe Float
ps Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled
Color -> IO ()
setColor Color
col
Float
s' <- StateVar Float -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar Float -> m Float
GLUT.get StateVar Float
GLUT.pointSize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Float -> Bool
forall a. Maybe a -> Bool
isJust Maybe Float
ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StateVar Float
GLUT.pointSize StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= (Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Float
ps)
PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GLUT.renderPrimitive PrimitiveMode
GLUT.Points (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(V3 GLdouble -> IO ()) -> [V3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(V3 GLdouble
x' GLdouble
y' GLdouble
z') -> Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
GLUT.vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x' GLdouble
y' GLdouble
z') [V3 GLdouble]
xyzs
StateVar Float
GLUT.pointSize StateVar Float -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar Float -> Float -> m ()
$= Float
s'
StateVar Capability
GLUT.lighting StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled
drawObject (Vis.VisObject.ObjModel (LoadedObjModel Vector GLdouble
vvec Vector GLdouble
nvec Int
numVerts) Color
col) =
IO () -> IO ()
forall a. IO a -> IO a
GLUT.preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Color -> IO ()
setMaterialDiffuse Color
col
Color -> IO ()
setColor Color
col
ClientArrayType -> StateVar Capability
GL.clientState ClientArrayType
GL.VertexArray StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
GL.Enabled
ClientArrayType -> StateVar Capability
GL.clientState ClientArrayType
GL.NormalArray StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
GL.Enabled
let va :: Ptr a -> VertexArrayDescriptor a
va = GLsizei -> DataType -> GLsizei -> Ptr a -> VertexArrayDescriptor a
forall a.
GLsizei -> DataType -> GLsizei -> Ptr a -> VertexArrayDescriptor a
GL.VertexArrayDescriptor GLsizei
3 DataType
GL.Double GLsizei
0
na :: Ptr a -> VertexArrayDescriptor a
na = GLsizei -> DataType -> GLsizei -> Ptr a -> VertexArrayDescriptor a
forall a.
GLsizei -> DataType -> GLsizei -> Ptr a -> VertexArrayDescriptor a
GL.VertexArrayDescriptor GLsizei
3 DataType
GL.Double GLsizei
0
Vector GLdouble -> (Ptr GLdouble -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector GLdouble
vvec ((Ptr GLdouble -> IO ()) -> IO ())
-> (Ptr GLdouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
vptr -> ClientArrayType -> StateVar (VertexArrayDescriptor GLdouble)
forall a. ClientArrayType -> StateVar (VertexArrayDescriptor a)
GL.arrayPointer ClientArrayType
GL.VertexArray StateVar (VertexArrayDescriptor GLdouble)
-> VertexArrayDescriptor GLdouble -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar (VertexArrayDescriptor GLdouble)
-> VertexArrayDescriptor GLdouble -> m ()
$= Ptr GLdouble -> VertexArrayDescriptor GLdouble
forall {a}. Ptr a -> VertexArrayDescriptor a
va Ptr GLdouble
vptr
Vector GLdouble -> (Ptr GLdouble -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector GLdouble
nvec ((Ptr GLdouble -> IO ()) -> IO ())
-> (Ptr GLdouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GLdouble
nptr -> ClientArrayType -> StateVar (VertexArrayDescriptor GLdouble)
forall a. ClientArrayType -> StateVar (VertexArrayDescriptor a)
GL.arrayPointer ClientArrayType
GL.NormalArray StateVar (VertexArrayDescriptor GLdouble)
-> VertexArrayDescriptor GLdouble -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar (VertexArrayDescriptor GLdouble)
-> VertexArrayDescriptor GLdouble -> m ()
$= Ptr GLdouble -> VertexArrayDescriptor GLdouble
forall {a}. Ptr a -> VertexArrayDescriptor a
na Ptr GLdouble
nptr
PrimitiveMode -> GLsizei -> GLsizei -> IO ()
GL.drawArrays PrimitiveMode
GL.Triangles GLsizei
0 (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numVerts)
ClientArrayType -> StateVar Capability
GL.clientState ClientArrayType
GL.VertexArray StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
GL.Disabled
ClientArrayType -> StateVar Capability
GL.clientState ClientArrayType
GL.NormalArray StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
GL.Disabled
loadObjModel :: F.Foldable f => f (V3 Double, V3 Double) -> LoadedObjModel
loadObjModel :: forall (f :: * -> *).
Foldable f =>
f (V3 GLdouble, V3 GLdouble) -> LoadedObjModel
loadObjModel f (V3 GLdouble, V3 GLdouble)
vns = Vector GLdouble -> Vector GLdouble -> Int -> LoadedObjModel
LoadedObjModel ([GLdouble] -> Vector GLdouble
forall a. Storable a => [a] -> Vector a
VS.fromList [GLdouble]
vs) ([GLdouble] -> Vector GLdouble
forall a. Storable a => [a] -> Vector a
VS.fromList [GLdouble]
ns) Int
n
where
vs :: [GLdouble]
vs = (V3 GLdouble -> [GLdouble]) -> [V3 GLdouble] -> [GLdouble]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
F.concatMap (\(V3 GLdouble
x GLdouble
y GLdouble
z) -> [GLdouble
x,GLdouble
y,GLdouble
z]) [V3 GLdouble]
vs'
ns :: [GLdouble]
ns = (V3 GLdouble -> [GLdouble]) -> [V3 GLdouble] -> [GLdouble]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
F.concatMap (\(V3 GLdouble
x GLdouble
y GLdouble
z) -> [GLdouble
x,GLdouble
y,GLdouble
z]) [V3 GLdouble]
ns'
([V3 GLdouble]
vs',[V3 GLdouble]
ns') = [(V3 GLdouble, V3 GLdouble)] -> ([V3 GLdouble], [V3 GLdouble])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(V3 GLdouble, V3 GLdouble)] -> ([V3 GLdouble], [V3 GLdouble]))
-> [(V3 GLdouble, V3 GLdouble)] -> ([V3 GLdouble], [V3 GLdouble])
forall a b. (a -> b) -> a -> b
$ f (V3 GLdouble, V3 GLdouble) -> [(V3 GLdouble, V3 GLdouble)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f (V3 GLdouble, V3 GLdouble)
vns
n :: Int
n = [V3 GLdouble] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [V3 GLdouble]
vs'