not-gloss-0.7.7.0: Painless 3D graphics, no affiliation with gloss

Safe HaskellNone
LanguageHaskell98

Vis

Synopsis

Documentation

data Options Source #

Constructors

Options 

Fields

Instances

data Camera0 Source #

Constructors

Camera0 

Instances

defaultOpts :: Options Source #

Some reasonable default options. Consider changing the window name with something like:

myOptions = defaultOpts {optWindowName = "my rad program"}

display Source #

Arguments

:: Real b 
=> Options

user options

-> VisObject b

object to draw

-> IO () 

draw a static image

animate Source #

Arguments

:: Real b 
=> Options

user options

-> (Float -> VisObject b)

draw function (takes time since start as input)

-> IO () 

simulate Source #

Arguments

:: Real b 
=> Options

user options

-> Double

sample rate

-> world

initial state

-> (world -> VisObject b)

draw function

-> (Float -> world -> world)

state propogation function (takes time since start and state as inputs)

-> IO () 

run a simulation

play Source #

Arguments

:: Real b 
=> Options

user options

-> Double

sample time

-> world

initial state

-> (world -> (VisObject b, Maybe Cursor))

draw function, can give a different cursor

-> (Float -> world -> world)

state propogation function (takes time since start and state as inputs)

-> (world -> IO ())

set where camera looks

-> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world)

keyboard/mouse press callback

-> Maybe (world -> Position -> world)

mouse drag callback

-> Maybe (world -> Position -> world)

mouse move callback

-> IO () 

animateIO Source #

Arguments

:: Real b 
=> Options

user options

-> (Float -> IO (VisObject b))

draw function (takes time since start as input)

-> IO () 

display an animation impurely

simulateIO Source #

Arguments

:: Real b 
=> Options

user options

-> Double

sample rate

-> world

initial state

-> (world -> IO (VisObject b))

draw function

-> (Float -> world -> IO world)

state propogation function (takes time since start and state as inputs)

-> IO () 

run a simulation impurely

playIO Source #

Arguments

:: Real b 
=> Options

user options

-> Double

sample time

-> world

initial state

-> (world -> IO (VisObject b, Maybe Cursor))

draw function, can give a different cursor

-> (Float -> world -> IO world)

state propogation function (takes time since start and state as inputs)

-> (world -> IO ())

set where camera looks

-> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world)

keyboard/mouse press callback

-> Maybe (world -> Position -> world)

mouse drag callback

-> Maybe (world -> Position -> world)

mouse move callback

-> IO () 

visMovie Source #

Arguments

:: Real b 
=> Options

user options

-> (Int -> FilePath)

where to write the bitmaps

-> Double

sample time

-> [VisObject b]

movie to draw

-> Maybe Cursor

optional cursor

-> IO () 

Make a series of images, one from each VisObject. When visMovie is executed a window pops up and loops the animation until you are happy with the camera angle. Hit spacebar and the images will be created and saved to disk.

data VisObject a Source #

Instances

Functor VisObject Source # 

Methods

fmap :: (a -> b) -> VisObject a -> VisObject b #

(<$) :: a -> VisObject b -> VisObject a #

Generic (VisObject a) Source # 

Associated Types

type Rep (VisObject a) :: * -> * #

Methods

from :: VisObject a -> Rep (VisObject a) x #

to :: Rep (VisObject a) x -> VisObject a #

Binary a => Binary (VisObject a) Source # 

Methods

put :: VisObject a -> Put #

get :: Get (VisObject a) #

type Rep (VisObject a) Source # 
type Rep (VisObject a) = D1 (MetaData "VisObject" "Vis.VisObject" "not-gloss-0.7.7.0-FUSTuXwr9c53SEKoBkQbhb" False) ((:+:) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "VisObjects" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [VisObject a]))) (C1 (MetaCons "Trans" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a)))))) ((:+:) (C1 (MetaCons "RotQuat" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Quaternion a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a))))) ((:+:) (C1 (MetaCons "RotDcm" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (M33 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a))))) (C1 (MetaCons "RotEulerRad" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Euler a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a)))))))) ((:+:) ((:+:) (C1 (MetaCons "RotEulerDeg" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Euler a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a))))) ((:+:) (C1 (MetaCons "Scale" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a, a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VisObject a))))) (C1 (MetaCons "Cylinder" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color)))))) ((:+:) (C1 (MetaCons "Box" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a, a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Flavour)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) ((:+:) (C1 (MetaCons "Cube" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Flavour)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) (C1 (MetaCons "Sphere" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Flavour)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "Ellipsoid" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a, a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Flavour)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) ((:+:) (C1 (MetaCons "Line" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [V3 a])) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) (C1 (MetaCons "Line'" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(V3 a, Color)])))))) ((:+:) (C1 (MetaCons "Arrow" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) ((:+:) (C1 (MetaCons "Axes" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a)))) (C1 (MetaCons "Plane" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color)))))))) ((:+:) ((:+:) (C1 (MetaCons "Triangle" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a)))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) ((:+:) (C1 (MetaCons "Quad" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a)))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color)))))) (C1 (MetaCons "Text3d" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (V3 a)))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 BitmapFont)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))))) ((:+:) (C1 (MetaCons "Text2d" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a, a)))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 BitmapFont)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) ((:+:) (C1 (MetaCons "Points" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [V3 a])) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe GLfloat))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color))))) (C1 (MetaCons "ObjModel" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 LoadedObjModel)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Color)))))))))

data SpecialKey :: * #

Special keys

Constructors

KeyF1 
KeyF2 
KeyF3 
KeyF4 
KeyF5 
KeyF6 
KeyF7 
KeyF8 
KeyF9 
KeyF10 
KeyF11 
KeyF12 
KeyLeft 
KeyUp 
KeyRight 
KeyDown 
KeyPageUp 
KeyPageDown 
KeyHome 
KeyEnd 
KeyInsert 
KeyNumLock 
KeyBegin 
KeyDelete 
KeyShiftL 
KeyShiftR 
KeyCtrlL 
KeyCtrlR 
KeyAltL 
KeyAltR 
KeyUnknown Int

You should actually never encounter this value, it is just here as a safeguard against future changes in the native GLUT library.

data BitmapFont :: * #

The bitmap fonts available in GLUT. The exact bitmap to be used is defined by the standard X glyph bitmaps for the X font with the given name.

Constructors

Fixed8By13

A fixed width font with every character fitting in an 8 by 13 pixel rectangle. (-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1)

Fixed9By15

A fixed width font with every character fitting in an 9 by 15 pixel rectangle. (-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1)

TimesRoman10

A 10-point proportional spaced Times Roman font. (-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1)

TimesRoman24

A 24-point proportional spaced Times Roman font. (-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1)

Helvetica10

A 10-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1)

Helvetica12

A 12-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1)

Helvetica18

A 18-point proportional spaced Helvetica font. (-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1)

data Flavour :: * #

Flavour of object rendering

Constructors

Solid

Object is rendered as a solid with shading and surface normals.

Wireframe

Object is rendered as a wireframe without surface normals.

loadObjModel :: Foldable f => f (V3 Double, V3 Double) -> LoadedObjModel Source #

turn a list of vertexnormal tuples into vertexnormal arrays