{-# OPTIONS -Wall #-}
{-# LANGUAGE DeriveAnyClass #-}

module Raylib.Types where

import Control.Monad (forM_, unless)
import Foreign
  ( FunPtr,
    Ptr,
    Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf),
    Word16,
    Word8,
    castPtr,
    fromBool,
    malloc,
    newArray,
    newForeignPtr,
    nullFunPtr,
    nullPtr,
    peekArray,
    toBool,
    withForeignPtr,
  )
import Foreign.C
  ( CBool,
    CChar,
    CFloat,
    CInt (..),
    CShort,
    CString,
    CUChar,
    CUInt,
    CUShort,
    castCharToCChar,
    newCString,
    peekCString,
  )
import Foreign.C.String (castCCharToChar)
import Raylib.ForeignUtil (Freeable (rlFreeDependents), c'free, freeMaybePtr, newMaybeArray, p'free, peekMaybeArray, peekStaticArray, peekStaticArrayOff, pokeMaybeOff, pokeStaticArray, pokeStaticArrayOff, rightPad, rlFreeArray, rlFreeMaybeArray)
import Raylib.Internal (c'rlGetShaderIdDefault, getPixelDataSize)

------------------------------------------------

-- Raylib enumerations -------------------------

------------------------------------------------


---- raylib.h


data ConfigFlag
  = VsyncHint
  | FullscreenMode
  | WindowResizable
  | WindowUndecorated
  | WindowHidden
  | WindowMinimized
  | WindowMaximized
  | WindowUnfocused
  | WindowTopmost
  | WindowAlwaysRun
  | WindowTransparent
  | WindowHighdpi
  | WindowMousePassthrough
  | Msaa4xHint
  | InterlacedHint
  deriving (ConfigFlag -> ConfigFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigFlag -> ConfigFlag -> Bool
$c/= :: ConfigFlag -> ConfigFlag -> Bool
== :: ConfigFlag -> ConfigFlag -> Bool
$c== :: ConfigFlag -> ConfigFlag -> Bool
Eq, Int -> ConfigFlag -> ShowS
[ConfigFlag] -> ShowS
ConfigFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigFlag] -> ShowS
$cshowList :: [ConfigFlag] -> ShowS
show :: ConfigFlag -> String
$cshow :: ConfigFlag -> String
showsPrec :: Int -> ConfigFlag -> ShowS
$cshowsPrec :: Int -> ConfigFlag -> ShowS
Show, ConfigFlag -> Ptr ConfigFlag -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: ConfigFlag -> Ptr ConfigFlag -> IO ()
$crlFree :: ConfigFlag -> Ptr ConfigFlag -> IO ()
rlFreeDependents :: ConfigFlag -> Ptr ConfigFlag -> IO ()
$crlFreeDependents :: ConfigFlag -> Ptr ConfigFlag -> IO ()
Freeable)

instance Enum ConfigFlag where
  fromEnum :: ConfigFlag -> Int
fromEnum ConfigFlag
g = case ConfigFlag
g of
    ConfigFlag
VsyncHint -> Int
64
    ConfigFlag
FullscreenMode -> Int
2
    ConfigFlag
WindowResizable -> Int
4
    ConfigFlag
WindowUndecorated -> Int
8
    ConfigFlag
WindowHidden -> Int
128
    ConfigFlag
WindowMinimized -> Int
512
    ConfigFlag
WindowMaximized -> Int
1024
    ConfigFlag
WindowUnfocused -> Int
2048
    ConfigFlag
WindowTopmost -> Int
4096
    ConfigFlag
WindowAlwaysRun -> Int
256
    ConfigFlag
WindowTransparent -> Int
16
    ConfigFlag
WindowHighdpi -> Int
8192
    ConfigFlag
WindowMousePassthrough -> Int
16384
    ConfigFlag
Msaa4xHint -> Int
32
    ConfigFlag
InterlacedHint -> Int
65536
  toEnum :: Int -> ConfigFlag
toEnum Int
x = case Int
x of
    Int
64 -> ConfigFlag
VsyncHint
    Int
2 -> ConfigFlag
FullscreenMode
    Int
4 -> ConfigFlag
WindowResizable
    Int
8 -> ConfigFlag
WindowUndecorated
    Int
128 -> ConfigFlag
WindowHidden
    Int
512 -> ConfigFlag
WindowMinimized
    Int
1024 -> ConfigFlag
WindowMaximized
    Int
2048 -> ConfigFlag
WindowUnfocused
    Int
4096 -> ConfigFlag
WindowTopmost
    Int
256 -> ConfigFlag
WindowAlwaysRun
    Int
16 -> ConfigFlag
WindowTransparent
    Int
8192 -> ConfigFlag
WindowHighdpi
    Int
16384 -> ConfigFlag
WindowMousePassthrough
    Int
32 -> ConfigFlag
Msaa4xHint
    Int
65536 -> ConfigFlag
InterlacedHint
    Int
n -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(ConfigFlag.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

data TraceLogLevel = LogAll | LogTrace | LogDebug | LogInfo | LogWarning | LogError | LogFatal | LogNone
  deriving (TraceLogLevel -> TraceLogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceLogLevel -> TraceLogLevel -> Bool
$c/= :: TraceLogLevel -> TraceLogLevel -> Bool
== :: TraceLogLevel -> TraceLogLevel -> Bool
$c== :: TraceLogLevel -> TraceLogLevel -> Bool
Eq, Int -> TraceLogLevel -> ShowS
[TraceLogLevel] -> ShowS
TraceLogLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceLogLevel] -> ShowS
$cshowList :: [TraceLogLevel] -> ShowS
show :: TraceLogLevel -> String
$cshow :: TraceLogLevel -> String
showsPrec :: Int -> TraceLogLevel -> ShowS
$cshowsPrec :: Int -> TraceLogLevel -> ShowS
Show, Int -> TraceLogLevel
TraceLogLevel -> Int
TraceLogLevel -> [TraceLogLevel]
TraceLogLevel -> TraceLogLevel
TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
TraceLogLevel -> TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TraceLogLevel -> TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
$cenumFromThenTo :: TraceLogLevel -> TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
enumFromTo :: TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
$cenumFromTo :: TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
enumFromThen :: TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
$cenumFromThen :: TraceLogLevel -> TraceLogLevel -> [TraceLogLevel]
enumFrom :: TraceLogLevel -> [TraceLogLevel]
$cenumFrom :: TraceLogLevel -> [TraceLogLevel]
fromEnum :: TraceLogLevel -> Int
$cfromEnum :: TraceLogLevel -> Int
toEnum :: Int -> TraceLogLevel
$ctoEnum :: Int -> TraceLogLevel
pred :: TraceLogLevel -> TraceLogLevel
$cpred :: TraceLogLevel -> TraceLogLevel
succ :: TraceLogLevel -> TraceLogLevel
$csucc :: TraceLogLevel -> TraceLogLevel
Enum)

data KeyboardKey
  = KeyNull
  | KeyApostrophe
  | KeyComma
  | KeyMinus
  | KeyPeriod
  | KeySlash
  | KeyZero
  | KeyOne
  | KeyTwo
  | KeyThree
  | KeyFour
  | KeyFive
  | KeySix
  | KeySeven
  | KeyEight
  | KeyNine
  | KeySemicolon
  | KeyEqual
  | KeyA
  | KeyB
  | KeyC
  | KeyD
  | KeyE
  | KeyF
  | KeyG
  | KeyH
  | KeyI
  | KeyJ
  | KeyK
  | KeyL
  | KeyM
  | KeyN
  | KeyO
  | KeyP
  | KeyQ
  | KeyR
  | KeyS
  | KeyT
  | KeyU
  | KeyV
  | KeyW
  | KeyX
  | KeyY
  | KeyZ
  | KeyLeftBracket
  | KeyBackslash
  | KeyRightBracket
  | KeyGrave
  | KeySpace
  | KeyEscape
  | KeyEnter
  | KeyTab
  | KeyBackspace
  | KeyInsert
  | KeyDelete
  | KeyRight
  | KeyLeft
  | KeyDown
  | KeyUp
  | KeyPageUp
  | KeyPageDown
  | KeyHome
  | KeyEnd
  | KeyCapsLock
  | KeyScrollLock
  | KeyNumLock
  | KeyPrintScreen
  | KeyPause
  | KeyF1
  | KeyF2
  | KeyF3
  | KeyF4
  | KeyF5
  | KeyF6
  | KeyF7
  | KeyF8
  | KeyF9
  | KeyF10
  | KeyF11
  | KeyF12
  | KeyLeftShift
  | KeyLeftControl
  | KeyLeftAlt
  | KeyLeftSuper
  | KeyRightShift
  | KeyRightControl
  | KeyRightAlt
  | KeyRightSuper
  | KeyKbMenu
  | KeyKp0
  | KeyKp1
  | KeyKp2
  | KeyKp3
  | KeyKp4
  | KeyKp5
  | KeyKp6
  | KeyKp7
  | KeyKp8
  | KeyKp9
  | KeyKpDecimal
  | KeyKpDivide
  | KeyKpMultiply
  | KeyKpSubtract
  | KeyKpAdd
  | KeyKpEnter
  | KeyKpEqual
  | KeyBack
  | KeyMenu
  | KeyVolumeUp
  | KeyVolumeDown
  deriving (KeyboardKey -> KeyboardKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyboardKey -> KeyboardKey -> Bool
$c/= :: KeyboardKey -> KeyboardKey -> Bool
== :: KeyboardKey -> KeyboardKey -> Bool
$c== :: KeyboardKey -> KeyboardKey -> Bool
Eq, Int -> KeyboardKey -> ShowS
[KeyboardKey] -> ShowS
KeyboardKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardKey] -> ShowS
$cshowList :: [KeyboardKey] -> ShowS
show :: KeyboardKey -> String
$cshow :: KeyboardKey -> String
showsPrec :: Int -> KeyboardKey -> ShowS
$cshowsPrec :: Int -> KeyboardKey -> ShowS
Show)

instance Enum KeyboardKey where
  fromEnum :: KeyboardKey -> Int
fromEnum KeyboardKey
k = case KeyboardKey
k of
    KeyboardKey
KeyNull -> Int
0
    KeyboardKey
KeyApostrophe -> Int
39
    KeyboardKey
KeyComma -> Int
44
    KeyboardKey
KeyMinus -> Int
45
    KeyboardKey
KeyPeriod -> Int
46
    KeyboardKey
KeySlash -> Int
47
    KeyboardKey
KeyZero -> Int
48
    KeyboardKey
KeyOne -> Int
49
    KeyboardKey
KeyTwo -> Int
50
    KeyboardKey
KeyThree -> Int
51
    KeyboardKey
KeyFour -> Int
52
    KeyboardKey
KeyFive -> Int
53
    KeyboardKey
KeySix -> Int
54
    KeyboardKey
KeySeven -> Int
55
    KeyboardKey
KeyEight -> Int
56
    KeyboardKey
KeyNine -> Int
57
    KeyboardKey
KeySemicolon -> Int
59
    KeyboardKey
KeyEqual -> Int
61
    KeyboardKey
KeyA -> Int
65
    KeyboardKey
KeyB -> Int
66
    KeyboardKey
KeyC -> Int
67
    KeyboardKey
KeyD -> Int
68
    KeyboardKey
KeyE -> Int
69
    KeyboardKey
KeyF -> Int
70
    KeyboardKey
KeyG -> Int
71
    KeyboardKey
KeyH -> Int
72
    KeyboardKey
KeyI -> Int
73
    KeyboardKey
KeyJ -> Int
74
    KeyboardKey
KeyK -> Int
75
    KeyboardKey
KeyL -> Int
76
    KeyboardKey
KeyM -> Int
77
    KeyboardKey
KeyN -> Int
78
    KeyboardKey
KeyO -> Int
79
    KeyboardKey
KeyP -> Int
80
    KeyboardKey
KeyQ -> Int
81
    KeyboardKey
KeyR -> Int
82
    KeyboardKey
KeyS -> Int
83
    KeyboardKey
KeyT -> Int
84
    KeyboardKey
KeyU -> Int
85
    KeyboardKey
KeyV -> Int
86
    KeyboardKey
KeyW -> Int
87
    KeyboardKey
KeyX -> Int
88
    KeyboardKey
KeyY -> Int
89
    KeyboardKey
KeyZ -> Int
90
    KeyboardKey
KeyLeftBracket -> Int
91
    KeyboardKey
KeyBackslash -> Int
92
    KeyboardKey
KeyRightBracket -> Int
93
    KeyboardKey
KeyGrave -> Int
96
    KeyboardKey
KeySpace -> Int
32
    KeyboardKey
KeyEscape -> Int
256
    KeyboardKey
KeyEnter -> Int
257
    KeyboardKey
KeyTab -> Int
258
    KeyboardKey
KeyBackspace -> Int
259
    KeyboardKey
KeyInsert -> Int
260
    KeyboardKey
KeyDelete -> Int
261
    KeyboardKey
KeyRight -> Int
262
    KeyboardKey
KeyLeft -> Int
263
    KeyboardKey
KeyDown -> Int
264
    KeyboardKey
KeyUp -> Int
265
    KeyboardKey
KeyPageUp -> Int
266
    KeyboardKey
KeyPageDown -> Int
267
    KeyboardKey
KeyHome -> Int
268
    KeyboardKey
KeyEnd -> Int
269
    KeyboardKey
KeyCapsLock -> Int
280
    KeyboardKey
KeyScrollLock -> Int
281
    KeyboardKey
KeyNumLock -> Int
282
    KeyboardKey
KeyPrintScreen -> Int
283
    KeyboardKey
KeyPause -> Int
284
    KeyboardKey
KeyF1 -> Int
290
    KeyboardKey
KeyF2 -> Int
291
    KeyboardKey
KeyF3 -> Int
292
    KeyboardKey
KeyF4 -> Int
293
    KeyboardKey
KeyF5 -> Int
294
    KeyboardKey
KeyF6 -> Int
295
    KeyboardKey
KeyF7 -> Int
296
    KeyboardKey
KeyF8 -> Int
297
    KeyboardKey
KeyF9 -> Int
298
    KeyboardKey
KeyF10 -> Int
299
    KeyboardKey
KeyF11 -> Int
300
    KeyboardKey
KeyF12 -> Int
301
    KeyboardKey
KeyLeftShift -> Int
340
    KeyboardKey
KeyLeftControl -> Int
341
    KeyboardKey
KeyLeftAlt -> Int
342
    KeyboardKey
KeyLeftSuper -> Int
343
    KeyboardKey
KeyRightShift -> Int
344
    KeyboardKey
KeyRightControl -> Int
345
    KeyboardKey
KeyRightAlt -> Int
346
    KeyboardKey
KeyRightSuper -> Int
347
    KeyboardKey
KeyKbMenu -> Int
348
    KeyboardKey
KeyKp0 -> Int
320
    KeyboardKey
KeyKp1 -> Int
321
    KeyboardKey
KeyKp2 -> Int
322
    KeyboardKey
KeyKp3 -> Int
323
    KeyboardKey
KeyKp4 -> Int
324
    KeyboardKey
KeyKp5 -> Int
325
    KeyboardKey
KeyKp6 -> Int
326
    KeyboardKey
KeyKp7 -> Int
327
    KeyboardKey
KeyKp8 -> Int
328
    KeyboardKey
KeyKp9 -> Int
329
    KeyboardKey
KeyKpDecimal -> Int
330
    KeyboardKey
KeyKpDivide -> Int
331
    KeyboardKey
KeyKpMultiply -> Int
332
    KeyboardKey
KeyKpSubtract -> Int
333
    KeyboardKey
KeyKpAdd -> Int
334
    KeyboardKey
KeyKpEnter -> Int
335
    KeyboardKey
KeyKpEqual -> Int
336
    -- Android buttons

    KeyboardKey
KeyBack -> Int
4
    KeyboardKey
KeyMenu -> Int
82
    KeyboardKey
KeyVolumeUp -> Int
24
    KeyboardKey
KeyVolumeDown -> Int
25

  toEnum :: Int -> KeyboardKey
toEnum Int
n = case Int
n of
    Int
0 -> KeyboardKey
KeyNull
    Int
39 -> KeyboardKey
KeyApostrophe
    Int
44 -> KeyboardKey
KeyComma
    Int
45 -> KeyboardKey
KeyMinus
    Int
46 -> KeyboardKey
KeyPeriod
    Int
47 -> KeyboardKey
KeySlash
    Int
48 -> KeyboardKey
KeyZero
    Int
49 -> KeyboardKey
KeyOne
    Int
50 -> KeyboardKey
KeyTwo
    Int
51 -> KeyboardKey
KeyThree
    Int
52 -> KeyboardKey
KeyFour
    Int
53 -> KeyboardKey
KeyFive
    Int
54 -> KeyboardKey
KeySix
    Int
55 -> KeyboardKey
KeySeven
    Int
56 -> KeyboardKey
KeyEight
    Int
57 -> KeyboardKey
KeyNine
    Int
59 -> KeyboardKey
KeySemicolon
    Int
61 -> KeyboardKey
KeyEqual
    Int
65 -> KeyboardKey
KeyA
    Int
66 -> KeyboardKey
KeyB
    Int
67 -> KeyboardKey
KeyC
    Int
68 -> KeyboardKey
KeyD
    Int
69 -> KeyboardKey
KeyE
    Int
70 -> KeyboardKey
KeyF
    Int
71 -> KeyboardKey
KeyG
    Int
72 -> KeyboardKey
KeyH
    Int
73 -> KeyboardKey
KeyI
    Int
74 -> KeyboardKey
KeyJ
    Int
75 -> KeyboardKey
KeyK
    Int
76 -> KeyboardKey
KeyL
    Int
77 -> KeyboardKey
KeyM
    Int
78 -> KeyboardKey
KeyN
    Int
79 -> KeyboardKey
KeyO
    Int
80 -> KeyboardKey
KeyP
    Int
81 -> KeyboardKey
KeyQ
    Int
82 -> KeyboardKey
KeyR
    Int
83 -> KeyboardKey
KeyS
    Int
84 -> KeyboardKey
KeyT
    Int
85 -> KeyboardKey
KeyU
    Int
86 -> KeyboardKey
KeyV
    Int
87 -> KeyboardKey
KeyW
    Int
88 -> KeyboardKey
KeyX
    Int
89 -> KeyboardKey
KeyY
    Int
90 -> KeyboardKey
KeyZ
    Int
91 -> KeyboardKey
KeyLeftBracket
    Int
92 -> KeyboardKey
KeyBackslash
    Int
93 -> KeyboardKey
KeyRightBracket
    Int
96 -> KeyboardKey
KeyGrave
    Int
32 -> KeyboardKey
KeySpace
    Int
256 -> KeyboardKey
KeyEscape
    Int
257 -> KeyboardKey
KeyEnter
    Int
258 -> KeyboardKey
KeyTab
    Int
259 -> KeyboardKey
KeyBackspace
    Int
260 -> KeyboardKey
KeyInsert
    Int
261 -> KeyboardKey
KeyDelete
    Int
262 -> KeyboardKey
KeyRight
    Int
263 -> KeyboardKey
KeyLeft
    Int
264 -> KeyboardKey
KeyDown
    Int
265 -> KeyboardKey
KeyUp
    Int
266 -> KeyboardKey
KeyPageUp
    Int
267 -> KeyboardKey
KeyPageDown
    Int
268 -> KeyboardKey
KeyHome
    Int
269 -> KeyboardKey
KeyEnd
    Int
280 -> KeyboardKey
KeyCapsLock
    Int
281 -> KeyboardKey
KeyScrollLock
    Int
282 -> KeyboardKey
KeyNumLock
    Int
283 -> KeyboardKey
KeyPrintScreen
    Int
284 -> KeyboardKey
KeyPause
    Int
290 -> KeyboardKey
KeyF1
    Int
291 -> KeyboardKey
KeyF2
    Int
292 -> KeyboardKey
KeyF3
    Int
293 -> KeyboardKey
KeyF4
    Int
294 -> KeyboardKey
KeyF5
    Int
295 -> KeyboardKey
KeyF6
    Int
296 -> KeyboardKey
KeyF7
    Int
297 -> KeyboardKey
KeyF8
    Int
298 -> KeyboardKey
KeyF9
    Int
299 -> KeyboardKey
KeyF10
    Int
300 -> KeyboardKey
KeyF11
    Int
301 -> KeyboardKey
KeyF12
    Int
340 -> KeyboardKey
KeyLeftShift
    Int
341 -> KeyboardKey
KeyLeftControl
    Int
342 -> KeyboardKey
KeyLeftAlt
    Int
343 -> KeyboardKey
KeyLeftSuper
    Int
344 -> KeyboardKey
KeyRightShift
    Int
345 -> KeyboardKey
KeyRightControl
    Int
346 -> KeyboardKey
KeyRightAlt
    Int
347 -> KeyboardKey
KeyRightSuper
    Int
348 -> KeyboardKey
KeyKbMenu
    Int
320 -> KeyboardKey
KeyKp0
    Int
321 -> KeyboardKey
KeyKp1
    Int
322 -> KeyboardKey
KeyKp2
    Int
323 -> KeyboardKey
KeyKp3
    Int
324 -> KeyboardKey
KeyKp4
    Int
325 -> KeyboardKey
KeyKp5
    Int
326 -> KeyboardKey
KeyKp6
    Int
327 -> KeyboardKey
KeyKp7
    Int
328 -> KeyboardKey
KeyKp8
    Int
329 -> KeyboardKey
KeyKp9
    Int
330 -> KeyboardKey
KeyKpDecimal
    Int
331 -> KeyboardKey
KeyKpDivide
    Int
332 -> KeyboardKey
KeyKpMultiply
    Int
333 -> KeyboardKey
KeyKpSubtract
    Int
334 -> KeyboardKey
KeyKpAdd
    Int
335 -> KeyboardKey
KeyKpEnter
    Int
336 -> KeyboardKey
KeyKpEqual
    -- Android buttons

    Int
4 -> KeyboardKey
KeyBack
    --  82  -> KeyMenu

    Int
24 -> KeyboardKey
KeyVolumeUp
    Int
25 -> KeyboardKey
KeyVolumeDown
    Int
x -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(KeyboardKey.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x

data MouseButton
  = MouseButtonLeft
  | MouseButtonRight
  | MouseButtonMiddle
  | MouseButtonSide
  | MouseButtonExtra
  | MouseButtonForward
  | MouseButtonBack
  deriving (MouseButton -> MouseButton -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c== :: MouseButton -> MouseButton -> Bool
Eq, Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseButton] -> ShowS
$cshowList :: [MouseButton] -> ShowS
show :: MouseButton -> String
$cshow :: MouseButton -> String
showsPrec :: Int -> MouseButton -> ShowS
$cshowsPrec :: Int -> MouseButton -> ShowS
Show, Int -> MouseButton
MouseButton -> Int
MouseButton -> [MouseButton]
MouseButton -> MouseButton
MouseButton -> MouseButton -> [MouseButton]
MouseButton -> MouseButton -> MouseButton -> [MouseButton]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
$cenumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
enumFromTo :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromTo :: MouseButton -> MouseButton -> [MouseButton]
enumFromThen :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromThen :: MouseButton -> MouseButton -> [MouseButton]
enumFrom :: MouseButton -> [MouseButton]
$cenumFrom :: MouseButton -> [MouseButton]
fromEnum :: MouseButton -> Int
$cfromEnum :: MouseButton -> Int
toEnum :: Int -> MouseButton
$ctoEnum :: Int -> MouseButton
pred :: MouseButton -> MouseButton
$cpred :: MouseButton -> MouseButton
succ :: MouseButton -> MouseButton
$csucc :: MouseButton -> MouseButton
Enum)

data MouseCursor
  = MouseCursorDefault
  | MouseCursorArrow
  | MouseCursorIbeam
  | MouseCursorCrosshair
  | MouseCursorPointingHand
  | MouseCursorResizeEW
  | MouseCursorResizeNS
  | MouseCursorResizeNWSE
  | MouseCursorResizeNESW
  | MouseCursorResizeAll
  | MouseCursorNotAllowed
  deriving (MouseCursor -> MouseCursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseCursor -> MouseCursor -> Bool
$c/= :: MouseCursor -> MouseCursor -> Bool
== :: MouseCursor -> MouseCursor -> Bool
$c== :: MouseCursor -> MouseCursor -> Bool
Eq, Int -> MouseCursor -> ShowS
[MouseCursor] -> ShowS
MouseCursor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseCursor] -> ShowS
$cshowList :: [MouseCursor] -> ShowS
show :: MouseCursor -> String
$cshow :: MouseCursor -> String
showsPrec :: Int -> MouseCursor -> ShowS
$cshowsPrec :: Int -> MouseCursor -> ShowS
Show, Int -> MouseCursor
MouseCursor -> Int
MouseCursor -> [MouseCursor]
MouseCursor -> MouseCursor
MouseCursor -> MouseCursor -> [MouseCursor]
MouseCursor -> MouseCursor -> MouseCursor -> [MouseCursor]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MouseCursor -> MouseCursor -> MouseCursor -> [MouseCursor]
$cenumFromThenTo :: MouseCursor -> MouseCursor -> MouseCursor -> [MouseCursor]
enumFromTo :: MouseCursor -> MouseCursor -> [MouseCursor]
$cenumFromTo :: MouseCursor -> MouseCursor -> [MouseCursor]
enumFromThen :: MouseCursor -> MouseCursor -> [MouseCursor]
$cenumFromThen :: MouseCursor -> MouseCursor -> [MouseCursor]
enumFrom :: MouseCursor -> [MouseCursor]
$cenumFrom :: MouseCursor -> [MouseCursor]
fromEnum :: MouseCursor -> Int
$cfromEnum :: MouseCursor -> Int
toEnum :: Int -> MouseCursor
$ctoEnum :: Int -> MouseCursor
pred :: MouseCursor -> MouseCursor
$cpred :: MouseCursor -> MouseCursor
succ :: MouseCursor -> MouseCursor
$csucc :: MouseCursor -> MouseCursor
Enum)

data GamepadButton
  = GamepadButtonUnknown
  | GamepadButtonUnknownLeftFaceUp
  | GamepadButtonLeftFaceRight
  | GamepadButtonLeftFaceDown
  | GamepadButtonLeftFaceLeft
  | GamepadButtonRightFaceUp
  | GamepadButtonRightFaceRight
  | GamepadButtonRightFaceDown
  | GamepadButtonRightFaceLeft
  | GamepadButtonLeftTrigger1
  | GamepadButtonLeftTrigger2
  | GamepadButtonRightTrigger1
  | GamepadButtonRightTrigger2
  | GamepadButtonMiddleLeft
  | GamepadButtonMiddle
  | GamepadButtonMiddleRight
  | GamepadButtonLeftThumb
  | GamepadButtonRightThumb
  deriving (GamepadButton -> GamepadButton -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GamepadButton -> GamepadButton -> Bool
$c/= :: GamepadButton -> GamepadButton -> Bool
== :: GamepadButton -> GamepadButton -> Bool
$c== :: GamepadButton -> GamepadButton -> Bool
Eq, Int -> GamepadButton -> ShowS
[GamepadButton] -> ShowS
GamepadButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GamepadButton] -> ShowS
$cshowList :: [GamepadButton] -> ShowS
show :: GamepadButton -> String
$cshow :: GamepadButton -> String
showsPrec :: Int -> GamepadButton -> ShowS
$cshowsPrec :: Int -> GamepadButton -> ShowS
Show, Int -> GamepadButton
GamepadButton -> Int
GamepadButton -> [GamepadButton]
GamepadButton -> GamepadButton
GamepadButton -> GamepadButton -> [GamepadButton]
GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromThenTo :: GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
enumFromTo :: GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromTo :: GamepadButton -> GamepadButton -> [GamepadButton]
enumFromThen :: GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromThen :: GamepadButton -> GamepadButton -> [GamepadButton]
enumFrom :: GamepadButton -> [GamepadButton]
$cenumFrom :: GamepadButton -> [GamepadButton]
fromEnum :: GamepadButton -> Int
$cfromEnum :: GamepadButton -> Int
toEnum :: Int -> GamepadButton
$ctoEnum :: Int -> GamepadButton
pred :: GamepadButton -> GamepadButton
$cpred :: GamepadButton -> GamepadButton
succ :: GamepadButton -> GamepadButton
$csucc :: GamepadButton -> GamepadButton
Enum)

data GamepadAxis
  = GamepadAxisLeftX
  | GamepadAxisLeftY
  | GamepadAxisRightX
  | GamepadAxisRightY
  | GamepadAxisLeftTrigger
  | GamepadAxisRightTrigger
  deriving (GamepadAxis -> GamepadAxis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GamepadAxis -> GamepadAxis -> Bool
$c/= :: GamepadAxis -> GamepadAxis -> Bool
== :: GamepadAxis -> GamepadAxis -> Bool
$c== :: GamepadAxis -> GamepadAxis -> Bool
Eq, Int -> GamepadAxis -> ShowS
[GamepadAxis] -> ShowS
GamepadAxis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GamepadAxis] -> ShowS
$cshowList :: [GamepadAxis] -> ShowS
show :: GamepadAxis -> String
$cshow :: GamepadAxis -> String
showsPrec :: Int -> GamepadAxis -> ShowS
$cshowsPrec :: Int -> GamepadAxis -> ShowS
Show, Int -> GamepadAxis
GamepadAxis -> Int
GamepadAxis -> [GamepadAxis]
GamepadAxis -> GamepadAxis
GamepadAxis -> GamepadAxis -> [GamepadAxis]
GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromThenTo :: GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFromTo :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromTo :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFromThen :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromThen :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFrom :: GamepadAxis -> [GamepadAxis]
$cenumFrom :: GamepadAxis -> [GamepadAxis]
fromEnum :: GamepadAxis -> Int
$cfromEnum :: GamepadAxis -> Int
toEnum :: Int -> GamepadAxis
$ctoEnum :: Int -> GamepadAxis
pred :: GamepadAxis -> GamepadAxis
$cpred :: GamepadAxis -> GamepadAxis
succ :: GamepadAxis -> GamepadAxis
$csucc :: GamepadAxis -> GamepadAxis
Enum)

data MaterialMapIndex
  = MaterialMapAlbedo
  | MaterialMapMetalness
  | MaterialMapNormal
  | MaterialMapRoughness
  | MaterialMapOcclusion
  | MaterialMapEmission
  | MaterialMapHeight
  | MaterialMapCubemap
  | MaterialMapIrradiance
  | MaterialMapPrefilter
  | MaterialMapBrdf
  deriving (MaterialMapIndex -> MaterialMapIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaterialMapIndex -> MaterialMapIndex -> Bool
$c/= :: MaterialMapIndex -> MaterialMapIndex -> Bool
== :: MaterialMapIndex -> MaterialMapIndex -> Bool
$c== :: MaterialMapIndex -> MaterialMapIndex -> Bool
Eq, Int -> MaterialMapIndex -> ShowS
[MaterialMapIndex] -> ShowS
MaterialMapIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaterialMapIndex] -> ShowS
$cshowList :: [MaterialMapIndex] -> ShowS
show :: MaterialMapIndex -> String
$cshow :: MaterialMapIndex -> String
showsPrec :: Int -> MaterialMapIndex -> ShowS
$cshowsPrec :: Int -> MaterialMapIndex -> ShowS
Show, Int -> MaterialMapIndex
MaterialMapIndex -> Int
MaterialMapIndex -> [MaterialMapIndex]
MaterialMapIndex -> MaterialMapIndex
MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
MaterialMapIndex
-> MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MaterialMapIndex
-> MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
$cenumFromThenTo :: MaterialMapIndex
-> MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
enumFromTo :: MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
$cenumFromTo :: MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
enumFromThen :: MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
$cenumFromThen :: MaterialMapIndex -> MaterialMapIndex -> [MaterialMapIndex]
enumFrom :: MaterialMapIndex -> [MaterialMapIndex]
$cenumFrom :: MaterialMapIndex -> [MaterialMapIndex]
fromEnum :: MaterialMapIndex -> Int
$cfromEnum :: MaterialMapIndex -> Int
toEnum :: Int -> MaterialMapIndex
$ctoEnum :: Int -> MaterialMapIndex
pred :: MaterialMapIndex -> MaterialMapIndex
$cpred :: MaterialMapIndex -> MaterialMapIndex
succ :: MaterialMapIndex -> MaterialMapIndex
$csucc :: MaterialMapIndex -> MaterialMapIndex
Enum)

data ShaderLocationIndex
  = ShaderLocVertexPosition
  | ShaderLocVertexTexcoord01
  | ShaderLocVertexTexcoord02
  | ShaderLocVertexNormal
  | ShaderLocVertexTangent
  | ShaderLocVertexColor
  | ShaderLocMatrixMvp
  | ShaderLocMatrixView
  | ShaderLocMatrixProjection
  | ShaderLocMatrixModel
  | ShaderLocMatrixNormal
  | ShaderLocVectorView
  | ShaderLocColorDiffuse
  | ShaderLocColorSpecular
  | ShaderLocColorAmbient
  | ShaderLocMapAlbedo
  | ShaderLocMapMetalness
  | ShaderLocMapNormal
  | ShaderLocMapRoughness
  | ShaderLocMapOcclusion
  | ShaderLocMapEmission
  | ShaderLocMapHeight
  | ShaderLocMapCubemap
  | ShaderLocMapIrradiance
  | ShaderLocMapPrefilter
  | ShaderLocMapBrdf
  deriving (ShaderLocationIndex -> ShaderLocationIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderLocationIndex -> ShaderLocationIndex -> Bool
$c/= :: ShaderLocationIndex -> ShaderLocationIndex -> Bool
== :: ShaderLocationIndex -> ShaderLocationIndex -> Bool
$c== :: ShaderLocationIndex -> ShaderLocationIndex -> Bool
Eq, Int -> ShaderLocationIndex -> ShowS
[ShaderLocationIndex] -> ShowS
ShaderLocationIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderLocationIndex] -> ShowS
$cshowList :: [ShaderLocationIndex] -> ShowS
show :: ShaderLocationIndex -> String
$cshow :: ShaderLocationIndex -> String
showsPrec :: Int -> ShaderLocationIndex -> ShowS
$cshowsPrec :: Int -> ShaderLocationIndex -> ShowS
Show, Int -> ShaderLocationIndex
ShaderLocationIndex -> Int
ShaderLocationIndex -> [ShaderLocationIndex]
ShaderLocationIndex -> ShaderLocationIndex
ShaderLocationIndex -> ShaderLocationIndex -> [ShaderLocationIndex]
ShaderLocationIndex
-> ShaderLocationIndex
-> ShaderLocationIndex
-> [ShaderLocationIndex]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShaderLocationIndex
-> ShaderLocationIndex
-> ShaderLocationIndex
-> [ShaderLocationIndex]
$cenumFromThenTo :: ShaderLocationIndex
-> ShaderLocationIndex
-> ShaderLocationIndex
-> [ShaderLocationIndex]
enumFromTo :: ShaderLocationIndex -> ShaderLocationIndex -> [ShaderLocationIndex]
$cenumFromTo :: ShaderLocationIndex -> ShaderLocationIndex -> [ShaderLocationIndex]
enumFromThen :: ShaderLocationIndex -> ShaderLocationIndex -> [ShaderLocationIndex]
$cenumFromThen :: ShaderLocationIndex -> ShaderLocationIndex -> [ShaderLocationIndex]
enumFrom :: ShaderLocationIndex -> [ShaderLocationIndex]
$cenumFrom :: ShaderLocationIndex -> [ShaderLocationIndex]
fromEnum :: ShaderLocationIndex -> Int
$cfromEnum :: ShaderLocationIndex -> Int
toEnum :: Int -> ShaderLocationIndex
$ctoEnum :: Int -> ShaderLocationIndex
pred :: ShaderLocationIndex -> ShaderLocationIndex
$cpred :: ShaderLocationIndex -> ShaderLocationIndex
succ :: ShaderLocationIndex -> ShaderLocationIndex
$csucc :: ShaderLocationIndex -> ShaderLocationIndex
Enum)

data ShaderUniformDataType
  = ShaderUniformFloatType
  | ShaderUniformVec2Type
  | ShaderUniformVec3Type
  | ShaderUniformVec4Type
  | ShaderUniformIntType
  | ShaderUniformIVec2Type
  | ShaderUniformIVec3Type
  | ShaderUniformIVec4Type
  | ShaderUniformSampler2DType
  deriving (ShaderUniformDataType -> ShaderUniformDataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderUniformDataType -> ShaderUniformDataType -> Bool
$c/= :: ShaderUniformDataType -> ShaderUniformDataType -> Bool
== :: ShaderUniformDataType -> ShaderUniformDataType -> Bool
$c== :: ShaderUniformDataType -> ShaderUniformDataType -> Bool
Eq, Int -> ShaderUniformDataType -> ShowS
[ShaderUniformDataType] -> ShowS
ShaderUniformDataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderUniformDataType] -> ShowS
$cshowList :: [ShaderUniformDataType] -> ShowS
show :: ShaderUniformDataType -> String
$cshow :: ShaderUniformDataType -> String
showsPrec :: Int -> ShaderUniformDataType -> ShowS
$cshowsPrec :: Int -> ShaderUniformDataType -> ShowS
Show, Int -> ShaderUniformDataType
ShaderUniformDataType -> Int
ShaderUniformDataType -> [ShaderUniformDataType]
ShaderUniformDataType -> ShaderUniformDataType
ShaderUniformDataType
-> ShaderUniformDataType -> [ShaderUniformDataType]
ShaderUniformDataType
-> ShaderUniformDataType
-> ShaderUniformDataType
-> [ShaderUniformDataType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShaderUniformDataType
-> ShaderUniformDataType
-> ShaderUniformDataType
-> [ShaderUniformDataType]
$cenumFromThenTo :: ShaderUniformDataType
-> ShaderUniformDataType
-> ShaderUniformDataType
-> [ShaderUniformDataType]
enumFromTo :: ShaderUniformDataType
-> ShaderUniformDataType -> [ShaderUniformDataType]
$cenumFromTo :: ShaderUniformDataType
-> ShaderUniformDataType -> [ShaderUniformDataType]
enumFromThen :: ShaderUniformDataType
-> ShaderUniformDataType -> [ShaderUniformDataType]
$cenumFromThen :: ShaderUniformDataType
-> ShaderUniformDataType -> [ShaderUniformDataType]
enumFrom :: ShaderUniformDataType -> [ShaderUniformDataType]
$cenumFrom :: ShaderUniformDataType -> [ShaderUniformDataType]
fromEnum :: ShaderUniformDataType -> Int
$cfromEnum :: ShaderUniformDataType -> Int
toEnum :: Int -> ShaderUniformDataType
$ctoEnum :: Int -> ShaderUniformDataType
pred :: ShaderUniformDataType -> ShaderUniformDataType
$cpred :: ShaderUniformDataType -> ShaderUniformDataType
succ :: ShaderUniformDataType -> ShaderUniformDataType
$csucc :: ShaderUniformDataType -> ShaderUniformDataType
Enum)

data ShaderUniformData
  = ShaderUniformFloat Float
  | ShaderUniformVec2 Vector2
  | ShaderUniformVec3 Vector3
  | ShaderUniformVec4 Vector4
  | ShaderUniformInt Int
  | ShaderUniformIVec2 (Int, Int)
  | ShaderUniformIVec3 (Int, Int, Int)
  | ShaderUniformIVec4 (Int, Int, Int, Int)
  | ShaderUniformSampler2D Texture
  deriving (ShaderUniformData -> ShaderUniformData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderUniformData -> ShaderUniformData -> Bool
$c/= :: ShaderUniformData -> ShaderUniformData -> Bool
== :: ShaderUniformData -> ShaderUniformData -> Bool
$c== :: ShaderUniformData -> ShaderUniformData -> Bool
Eq, Int -> ShaderUniformData -> ShowS
[ShaderUniformData] -> ShowS
ShaderUniformData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderUniformData] -> ShowS
$cshowList :: [ShaderUniformData] -> ShowS
show :: ShaderUniformData -> String
$cshow :: ShaderUniformData -> String
showsPrec :: Int -> ShaderUniformData -> ShowS
$cshowsPrec :: Int -> ShaderUniformData -> ShowS
Show)

data ShaderUniformDataV
  = ShaderUniformFloatV [Float]
  | ShaderUniformVec2V [Vector2]
  | ShaderUniformVec3V [Vector3]
  | ShaderUniformVec4V [Vector4]
  | ShaderUniformIntV [Int]
  | ShaderUniformIVec2V [(Int, Int)]
  | ShaderUniformIVec3V [(Int, Int, Int)]
  | ShaderUniformIVec4V [(Int, Int, Int, Int)]
  | ShaderUniformSampler2DV [Texture]
  deriving (ShaderUniformDataV -> ShaderUniformDataV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderUniformDataV -> ShaderUniformDataV -> Bool
$c/= :: ShaderUniformDataV -> ShaderUniformDataV -> Bool
== :: ShaderUniformDataV -> ShaderUniformDataV -> Bool
$c== :: ShaderUniformDataV -> ShaderUniformDataV -> Bool
Eq, Int -> ShaderUniformDataV -> ShowS
[ShaderUniformDataV] -> ShowS
ShaderUniformDataV -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderUniformDataV] -> ShowS
$cshowList :: [ShaderUniformDataV] -> ShowS
show :: ShaderUniformDataV -> String
$cshow :: ShaderUniformDataV -> String
showsPrec :: Int -> ShaderUniformDataV -> ShowS
$cshowsPrec :: Int -> ShaderUniformDataV -> ShowS
Show)

-- I don't know if there's a cleaner way to do this

unpackShaderUniformData :: ShaderUniformData -> IO (ShaderUniformDataType, Ptr ())
unpackShaderUniformData :: ShaderUniformData -> IO (ShaderUniformDataType, Ptr ())
unpackShaderUniformData ShaderUniformData
u = do
  case ShaderUniformData
u of
    (ShaderUniformFloat Float
f) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => IO (Ptr a)
malloc
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
ptr (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f :: CFloat)
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformFloatType, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr)
    (ShaderUniformVec2 (Vector2 Float
x Float
y)) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float
x, Float
y] :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec2Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr)
    (ShaderUniformVec3 (Vector3 Float
x Float
y Float
z)) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float
x, Float
y, Float
z] :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec3Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr)
    (ShaderUniformVec4 (Vector4 Float
x Float
y Float
z Float
w)) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float
x, Float
y, Float
z, Float
w] :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec4Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr)
    (ShaderUniformInt Int
i) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => IO (Ptr a)
malloc
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: CInt)
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIntType, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr)
    (ShaderUniformIVec2 (Int
i1, Int
i2)) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
i1, Int
i2] :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec2Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr)
    (ShaderUniformIVec3 (Int
i1, Int
i2, Int
i3)) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
i1, Int
i2, Int
i3] :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec3Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr)
    (ShaderUniformIVec4 (Int
i1, Int
i2, Int
i3, Int
i4)) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
i1, Int
i2, Int
i3, Int
i4] :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec4Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr)
    (ShaderUniformSampler2D Texture
texture) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => IO (Ptr a)
malloc
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Texture -> Integer
texture'id Texture
texture :: CInt)
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformSampler2DType, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr)

unpackShaderUniformDataV :: ShaderUniformDataV -> IO (ShaderUniformDataType, Ptr (), Int)
unpackShaderUniformDataV :: ShaderUniformDataV -> IO (ShaderUniformDataType, Ptr (), Int)
unpackShaderUniformDataV ShaderUniformDataV
xs = do
  case ShaderUniformDataV
xs of
    (ShaderUniformFloatV [Float]
fs) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
fs :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformFloatType, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
fs)
    (ShaderUniformVec2V [Vector2]
vs) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Vector2 Float
x Float
y) -> [Float
x, Float
y]) [Vector2]
vs :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec2Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector2]
vs)
    (ShaderUniformVec3V [Vector3]
vs) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Vector3 Float
x Float
y Float
z) -> [Float
x, Float
y, Float
z]) [Vector3]
vs :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec3Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector3]
vs)
    (ShaderUniformVec4V [Vector4]
vs) ->
      do
        Ptr CFloat
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Vector4 Float
x Float
y Float
z Float
w) -> [Float
x, Float
y, Float
z, Float
w]) [Vector4]
vs :: [CFloat])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformVec4Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector4]
vs)
    (ShaderUniformIntV [Int]
is) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
is :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIntType, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is)
    (ShaderUniformIVec2V [(Int, Int)]
is) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
x, Int
y) -> [Int
x, Int
y]) [(Int, Int)]
is :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec2Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
is)
    (ShaderUniformIVec3V [(Int, Int, Int)]
is) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
x, Int
y, Int
z) -> [Int
x, Int
y, Int
z]) [(Int, Int, Int)]
is :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec3Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int, Int)]
is)
    (ShaderUniformIVec4V [(Int, Int, Int, Int)]
is) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
x, Int
y, Int
z, Int
w) -> [Int
x, Int
y, Int
z, Int
w]) [(Int, Int, Int, Int)]
is :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformIVec4Type, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int, Int, Int)]
is)
    (ShaderUniformSampler2DV [Texture]
textures) ->
      do
        Ptr CInt
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture -> Integer
texture'id) [Texture]
textures :: [CInt])
        forall (m :: * -> *) a. Monad m => a -> m a
return (ShaderUniformDataType
ShaderUniformSampler2DType, forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
ptr, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Texture]
textures)

-- I genuinely have no idea where this is used.

data ShaderAttributeDataType
  = ShaderAttribFloat
  | ShaderAttribVec2
  | ShaderAttribVec3
  | ShaderAttribVec4
  deriving (ShaderAttributeDataType -> ShaderAttributeDataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderAttributeDataType -> ShaderAttributeDataType -> Bool
$c/= :: ShaderAttributeDataType -> ShaderAttributeDataType -> Bool
== :: ShaderAttributeDataType -> ShaderAttributeDataType -> Bool
$c== :: ShaderAttributeDataType -> ShaderAttributeDataType -> Bool
Eq, Int -> ShaderAttributeDataType -> ShowS
[ShaderAttributeDataType] -> ShowS
ShaderAttributeDataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderAttributeDataType] -> ShowS
$cshowList :: [ShaderAttributeDataType] -> ShowS
show :: ShaderAttributeDataType -> String
$cshow :: ShaderAttributeDataType -> String
showsPrec :: Int -> ShaderAttributeDataType -> ShowS
$cshowsPrec :: Int -> ShaderAttributeDataType -> ShowS
Show, Int -> ShaderAttributeDataType
ShaderAttributeDataType -> Int
ShaderAttributeDataType -> [ShaderAttributeDataType]
ShaderAttributeDataType -> ShaderAttributeDataType
ShaderAttributeDataType
-> ShaderAttributeDataType -> [ShaderAttributeDataType]
ShaderAttributeDataType
-> ShaderAttributeDataType
-> ShaderAttributeDataType
-> [ShaderAttributeDataType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShaderAttributeDataType
-> ShaderAttributeDataType
-> ShaderAttributeDataType
-> [ShaderAttributeDataType]
$cenumFromThenTo :: ShaderAttributeDataType
-> ShaderAttributeDataType
-> ShaderAttributeDataType
-> [ShaderAttributeDataType]
enumFromTo :: ShaderAttributeDataType
-> ShaderAttributeDataType -> [ShaderAttributeDataType]
$cenumFromTo :: ShaderAttributeDataType
-> ShaderAttributeDataType -> [ShaderAttributeDataType]
enumFromThen :: ShaderAttributeDataType
-> ShaderAttributeDataType -> [ShaderAttributeDataType]
$cenumFromThen :: ShaderAttributeDataType
-> ShaderAttributeDataType -> [ShaderAttributeDataType]
enumFrom :: ShaderAttributeDataType -> [ShaderAttributeDataType]
$cenumFrom :: ShaderAttributeDataType -> [ShaderAttributeDataType]
fromEnum :: ShaderAttributeDataType -> Int
$cfromEnum :: ShaderAttributeDataType -> Int
toEnum :: Int -> ShaderAttributeDataType
$ctoEnum :: Int -> ShaderAttributeDataType
pred :: ShaderAttributeDataType -> ShaderAttributeDataType
$cpred :: ShaderAttributeDataType -> ShaderAttributeDataType
succ :: ShaderAttributeDataType -> ShaderAttributeDataType
$csucc :: ShaderAttributeDataType -> ShaderAttributeDataType
Enum)

data PixelFormat
  = PixelFormatUnset
  | PixelFormatUncompressedGrayscale
  | PixelFormatUncompressedGrayAlpha
  | PixelFormatUncompressedR5G6B5
  | PixelFormatUncompressedR8G8B8
  | PixelFormatUncompressedR5G5B5A1
  | PixelFormatUncompressedR4G4B4A4
  | PixelFormatUncompressedR8G8B8A8
  | PixelFormatUncompressedR32
  | PixelFormatUncompressedR32G32B32
  | PixelFormatUncompressedR32G32B32A32
  | PixelFormatCompressedDxt1Rgb
  | PixelFormatCompressedDxt1Rgba
  | PixelFormatCompressedDxt3Rgba
  | PixelFormatCompressedDxt5Rgba
  | PixelFormatCompressedEtc1Rgb
  | PixelFormatCompressedEtc2Rgb
  | PixelFormatCompressedEtc2EacRgba
  | PixelFormatCompressedPvrtRgb
  | PixelFormatCompressedPvrtRgba
  | PixelFormatCompressedAstc4x4Rgba
  | PixelFormatCompressedAstc8x8Rgba
  deriving (PixelFormat -> PixelFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixelFormat -> PixelFormat -> Bool
$c/= :: PixelFormat -> PixelFormat -> Bool
== :: PixelFormat -> PixelFormat -> Bool
$c== :: PixelFormat -> PixelFormat -> Bool
Eq, Int -> PixelFormat -> ShowS
[PixelFormat] -> ShowS
PixelFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixelFormat] -> ShowS
$cshowList :: [PixelFormat] -> ShowS
show :: PixelFormat -> String
$cshow :: PixelFormat -> String
showsPrec :: Int -> PixelFormat -> ShowS
$cshowsPrec :: Int -> PixelFormat -> ShowS
Show)

instance Storable PixelFormat where
  sizeOf :: PixelFormat -> Int
sizeOf PixelFormat
_ = Int
4
  alignment :: PixelFormat -> Int
alignment PixelFormat
_ = Int
4
  peek :: Ptr PixelFormat -> IO PixelFormat
peek Ptr PixelFormat
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr PixelFormat
ptr :: Ptr CInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
val)
  poke :: Ptr PixelFormat -> PixelFormat -> IO ()
poke Ptr PixelFormat
ptr PixelFormat
v = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr PixelFormat
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum PixelFormat
v) :: CInt)

instance Enum PixelFormat where
  fromEnum :: PixelFormat -> Int
fromEnum PixelFormat
n = case PixelFormat
n of
    PixelFormat
PixelFormatUnset -> Int
0
    PixelFormat
PixelFormatUncompressedGrayscale -> Int
1
    PixelFormat
PixelFormatUncompressedGrayAlpha -> Int
2
    PixelFormat
PixelFormatUncompressedR5G6B5 -> Int
3
    PixelFormat
PixelFormatUncompressedR8G8B8 -> Int
4
    PixelFormat
PixelFormatUncompressedR5G5B5A1 -> Int
5
    PixelFormat
PixelFormatUncompressedR4G4B4A4 -> Int
6
    PixelFormat
PixelFormatUncompressedR8G8B8A8 -> Int
7
    PixelFormat
PixelFormatUncompressedR32 -> Int
8
    PixelFormat
PixelFormatUncompressedR32G32B32 -> Int
9
    PixelFormat
PixelFormatUncompressedR32G32B32A32 -> Int
10
    PixelFormat
PixelFormatCompressedDxt1Rgb -> Int
11
    PixelFormat
PixelFormatCompressedDxt1Rgba -> Int
12
    PixelFormat
PixelFormatCompressedDxt3Rgba -> Int
13
    PixelFormat
PixelFormatCompressedDxt5Rgba -> Int
14
    PixelFormat
PixelFormatCompressedEtc1Rgb -> Int
15
    PixelFormat
PixelFormatCompressedEtc2Rgb -> Int
16
    PixelFormat
PixelFormatCompressedEtc2EacRgba -> Int
17
    PixelFormat
PixelFormatCompressedPvrtRgb -> Int
18
    PixelFormat
PixelFormatCompressedPvrtRgba -> Int
19
    PixelFormat
PixelFormatCompressedAstc4x4Rgba -> Int
20
    PixelFormat
PixelFormatCompressedAstc8x8Rgba -> Int
21

  toEnum :: Int -> PixelFormat
toEnum Int
n = case Int
n of
    Int
0 -> PixelFormat
PixelFormatUnset
    Int
1 -> PixelFormat
PixelFormatUncompressedGrayscale
    Int
2 -> PixelFormat
PixelFormatUncompressedGrayAlpha
    Int
3 -> PixelFormat
PixelFormatUncompressedR5G6B5
    Int
4 -> PixelFormat
PixelFormatUncompressedR8G8B8
    Int
5 -> PixelFormat
PixelFormatUncompressedR5G5B5A1
    Int
6 -> PixelFormat
PixelFormatUncompressedR4G4B4A4
    Int
7 -> PixelFormat
PixelFormatUncompressedR8G8B8A8
    Int
8 -> PixelFormat
PixelFormatUncompressedR32
    Int
9 -> PixelFormat
PixelFormatUncompressedR32G32B32
    Int
10 -> PixelFormat
PixelFormatUncompressedR32G32B32A32
    Int
11 -> PixelFormat
PixelFormatCompressedDxt1Rgb
    Int
12 -> PixelFormat
PixelFormatCompressedDxt1Rgba
    Int
13 -> PixelFormat
PixelFormatCompressedDxt3Rgba
    Int
14 -> PixelFormat
PixelFormatCompressedDxt5Rgba
    Int
15 -> PixelFormat
PixelFormatCompressedEtc1Rgb
    Int
16 -> PixelFormat
PixelFormatCompressedEtc2Rgb
    Int
17 -> PixelFormat
PixelFormatCompressedEtc2EacRgba
    Int
18 -> PixelFormat
PixelFormatCompressedPvrtRgb
    Int
19 -> PixelFormat
PixelFormatCompressedPvrtRgba
    Int
20 -> PixelFormat
PixelFormatCompressedAstc4x4Rgba
    Int
21 -> PixelFormat
PixelFormatCompressedAstc8x8Rgba
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(PixelFormat.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

data TextureFilter
  = TextureFilterPoint
  | TextureFilterBilinear
  | TextureFilterTrilinear
  | TextureFilterAnisotropic4x
  | TextureFilterAnisotropic8x
  | TextureFilterAnisotropic16x
  deriving (Int -> TextureFilter
TextureFilter -> Int
TextureFilter -> [TextureFilter]
TextureFilter -> TextureFilter
TextureFilter -> TextureFilter -> [TextureFilter]
TextureFilter -> TextureFilter -> TextureFilter -> [TextureFilter]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TextureFilter -> TextureFilter -> TextureFilter -> [TextureFilter]
$cenumFromThenTo :: TextureFilter -> TextureFilter -> TextureFilter -> [TextureFilter]
enumFromTo :: TextureFilter -> TextureFilter -> [TextureFilter]
$cenumFromTo :: TextureFilter -> TextureFilter -> [TextureFilter]
enumFromThen :: TextureFilter -> TextureFilter -> [TextureFilter]
$cenumFromThen :: TextureFilter -> TextureFilter -> [TextureFilter]
enumFrom :: TextureFilter -> [TextureFilter]
$cenumFrom :: TextureFilter -> [TextureFilter]
fromEnum :: TextureFilter -> Int
$cfromEnum :: TextureFilter -> Int
toEnum :: Int -> TextureFilter
$ctoEnum :: Int -> TextureFilter
pred :: TextureFilter -> TextureFilter
$cpred :: TextureFilter -> TextureFilter
succ :: TextureFilter -> TextureFilter
$csucc :: TextureFilter -> TextureFilter
Enum)

data TextureWrap
  = TextureWrapRepeat
  | TextureWrapClamp
  | TextureWrapMirrorRepeat
  | TextureWrapMirrorClamp
  deriving (Int -> TextureWrap
TextureWrap -> Int
TextureWrap -> [TextureWrap]
TextureWrap -> TextureWrap
TextureWrap -> TextureWrap -> [TextureWrap]
TextureWrap -> TextureWrap -> TextureWrap -> [TextureWrap]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TextureWrap -> TextureWrap -> TextureWrap -> [TextureWrap]
$cenumFromThenTo :: TextureWrap -> TextureWrap -> TextureWrap -> [TextureWrap]
enumFromTo :: TextureWrap -> TextureWrap -> [TextureWrap]
$cenumFromTo :: TextureWrap -> TextureWrap -> [TextureWrap]
enumFromThen :: TextureWrap -> TextureWrap -> [TextureWrap]
$cenumFromThen :: TextureWrap -> TextureWrap -> [TextureWrap]
enumFrom :: TextureWrap -> [TextureWrap]
$cenumFrom :: TextureWrap -> [TextureWrap]
fromEnum :: TextureWrap -> Int
$cfromEnum :: TextureWrap -> Int
toEnum :: Int -> TextureWrap
$ctoEnum :: Int -> TextureWrap
pred :: TextureWrap -> TextureWrap
$cpred :: TextureWrap -> TextureWrap
succ :: TextureWrap -> TextureWrap
$csucc :: TextureWrap -> TextureWrap
Enum)

data CubemapLayout
  = CubemapLayoutAutoDetect
  | CubemapLayoutLineVertical
  | CubemapLayoutLineHorizontal
  | CubemapLayoutCrossThreeByFour
  | CubemapLayoutCrossThreeByThree
  | CubemapLayoutPanorama
  deriving (Int -> CubemapLayout
CubemapLayout -> Int
CubemapLayout -> [CubemapLayout]
CubemapLayout -> CubemapLayout
CubemapLayout -> CubemapLayout -> [CubemapLayout]
CubemapLayout -> CubemapLayout -> CubemapLayout -> [CubemapLayout]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CubemapLayout -> CubemapLayout -> CubemapLayout -> [CubemapLayout]
$cenumFromThenTo :: CubemapLayout -> CubemapLayout -> CubemapLayout -> [CubemapLayout]
enumFromTo :: CubemapLayout -> CubemapLayout -> [CubemapLayout]
$cenumFromTo :: CubemapLayout -> CubemapLayout -> [CubemapLayout]
enumFromThen :: CubemapLayout -> CubemapLayout -> [CubemapLayout]
$cenumFromThen :: CubemapLayout -> CubemapLayout -> [CubemapLayout]
enumFrom :: CubemapLayout -> [CubemapLayout]
$cenumFrom :: CubemapLayout -> [CubemapLayout]
fromEnum :: CubemapLayout -> Int
$cfromEnum :: CubemapLayout -> Int
toEnum :: Int -> CubemapLayout
$ctoEnum :: Int -> CubemapLayout
pred :: CubemapLayout -> CubemapLayout
$cpred :: CubemapLayout -> CubemapLayout
succ :: CubemapLayout -> CubemapLayout
$csucc :: CubemapLayout -> CubemapLayout
Enum)

data FontType = FontDefault | FontBitmap | FontSDF deriving (Int -> FontType
FontType -> Int
FontType -> [FontType]
FontType -> FontType
FontType -> FontType -> [FontType]
FontType -> FontType -> FontType -> [FontType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontType -> FontType -> FontType -> [FontType]
$cenumFromThenTo :: FontType -> FontType -> FontType -> [FontType]
enumFromTo :: FontType -> FontType -> [FontType]
$cenumFromTo :: FontType -> FontType -> [FontType]
enumFromThen :: FontType -> FontType -> [FontType]
$cenumFromThen :: FontType -> FontType -> [FontType]
enumFrom :: FontType -> [FontType]
$cenumFrom :: FontType -> [FontType]
fromEnum :: FontType -> Int
$cfromEnum :: FontType -> Int
toEnum :: Int -> FontType
$ctoEnum :: Int -> FontType
pred :: FontType -> FontType
$cpred :: FontType -> FontType
succ :: FontType -> FontType
$csucc :: FontType -> FontType
Enum)

data BlendMode
  = BlendAlpha
  | BlendAdditive
  | BlendMultiplied
  | BlendAddColors
  | BlendSubtractColors
  | BlendAlphaPremultiply
  | BlendCustom
  | BlendCustomSeparate
  deriving (Int -> BlendMode
BlendMode -> Int
BlendMode -> [BlendMode]
BlendMode -> BlendMode
BlendMode -> BlendMode -> [BlendMode]
BlendMode -> BlendMode -> BlendMode -> [BlendMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlendMode -> BlendMode -> BlendMode -> [BlendMode]
$cenumFromThenTo :: BlendMode -> BlendMode -> BlendMode -> [BlendMode]
enumFromTo :: BlendMode -> BlendMode -> [BlendMode]
$cenumFromTo :: BlendMode -> BlendMode -> [BlendMode]
enumFromThen :: BlendMode -> BlendMode -> [BlendMode]
$cenumFromThen :: BlendMode -> BlendMode -> [BlendMode]
enumFrom :: BlendMode -> [BlendMode]
$cenumFrom :: BlendMode -> [BlendMode]
fromEnum :: BlendMode -> Int
$cfromEnum :: BlendMode -> Int
toEnum :: Int -> BlendMode
$ctoEnum :: Int -> BlendMode
pred :: BlendMode -> BlendMode
$cpred :: BlendMode -> BlendMode
succ :: BlendMode -> BlendMode
$csucc :: BlendMode -> BlendMode
Enum)

data Gesture
  = GestureNone
  | GestureTap
  | GestureDoubleTap
  | GestureHold
  | GestureDrag
  | GestureSwipeRight
  | GestureSwipeLeft
  | GestureSwipeUp
  | GestureSwipeDown
  | GesturePinchIn
  | GesturePinchOut
  deriving (Int -> Gesture -> ShowS
[Gesture] -> ShowS
Gesture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gesture] -> ShowS
$cshowList :: [Gesture] -> ShowS
show :: Gesture -> String
$cshow :: Gesture -> String
showsPrec :: Int -> Gesture -> ShowS
$cshowsPrec :: Int -> Gesture -> ShowS
Show)

-- NOTE: This is not the ideal solution, I need to make this unjanky

instance Enum Gesture where
  fromEnum :: Gesture -> Int
fromEnum Gesture
n = case Gesture
n of
    Gesture
GestureNone -> Int
0
    Gesture
GestureTap -> Int
1
    Gesture
GestureDoubleTap -> Int
2
    Gesture
GestureHold -> Int
4
    Gesture
GestureDrag -> Int
8
    Gesture
GestureSwipeRight -> Int
16
    Gesture
GestureSwipeLeft -> Int
32
    Gesture
GestureSwipeUp -> Int
64
    Gesture
GestureSwipeDown -> Int
128
    Gesture
GesturePinchIn -> Int
256
    Gesture
GesturePinchOut -> Int
512
  toEnum :: Int -> Gesture
toEnum Int
n = case Int
n of
    Int
0 -> Gesture
GestureNone
    Int
1 -> Gesture
GestureTap
    Int
2 -> Gesture
GestureDoubleTap
    Int
4 -> Gesture
GestureHold
    Int
8 -> Gesture
GestureDrag
    Int
16 -> Gesture
GestureSwipeRight
    Int
32 -> Gesture
GestureSwipeLeft
    Int
64 -> Gesture
GestureSwipeUp
    Int
128 -> Gesture
GestureSwipeDown
    Int
256 -> Gesture
GesturePinchIn
    Int
512 -> Gesture
GesturePinchOut
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(Gesture.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

data CameraMode
  = CameraModeCustom
  | CameraModeFree
  | CameraModeOrbital
  | CameraModeFirstPerson
  | CameraModeThirdPerson
  deriving (Int -> CameraMode
CameraMode -> Int
CameraMode -> [CameraMode]
CameraMode -> CameraMode
CameraMode -> CameraMode -> [CameraMode]
CameraMode -> CameraMode -> CameraMode -> [CameraMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CameraMode -> CameraMode -> CameraMode -> [CameraMode]
$cenumFromThenTo :: CameraMode -> CameraMode -> CameraMode -> [CameraMode]
enumFromTo :: CameraMode -> CameraMode -> [CameraMode]
$cenumFromTo :: CameraMode -> CameraMode -> [CameraMode]
enumFromThen :: CameraMode -> CameraMode -> [CameraMode]
$cenumFromThen :: CameraMode -> CameraMode -> [CameraMode]
enumFrom :: CameraMode -> [CameraMode]
$cenumFrom :: CameraMode -> [CameraMode]
fromEnum :: CameraMode -> Int
$cfromEnum :: CameraMode -> Int
toEnum :: Int -> CameraMode
$ctoEnum :: Int -> CameraMode
pred :: CameraMode -> CameraMode
$cpred :: CameraMode -> CameraMode
succ :: CameraMode -> CameraMode
$csucc :: CameraMode -> CameraMode
Enum)

data CameraProjection = CameraPerspective | CameraOrthographic deriving (CameraProjection -> CameraProjection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CameraProjection -> CameraProjection -> Bool
$c/= :: CameraProjection -> CameraProjection -> Bool
== :: CameraProjection -> CameraProjection -> Bool
$c== :: CameraProjection -> CameraProjection -> Bool
Eq, Int -> CameraProjection -> ShowS
[CameraProjection] -> ShowS
CameraProjection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CameraProjection] -> ShowS
$cshowList :: [CameraProjection] -> ShowS
show :: CameraProjection -> String
$cshow :: CameraProjection -> String
showsPrec :: Int -> CameraProjection -> ShowS
$cshowsPrec :: Int -> CameraProjection -> ShowS
Show, Int -> CameraProjection
CameraProjection -> Int
CameraProjection -> [CameraProjection]
CameraProjection -> CameraProjection
CameraProjection -> CameraProjection -> [CameraProjection]
CameraProjection
-> CameraProjection -> CameraProjection -> [CameraProjection]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CameraProjection
-> CameraProjection -> CameraProjection -> [CameraProjection]
$cenumFromThenTo :: CameraProjection
-> CameraProjection -> CameraProjection -> [CameraProjection]
enumFromTo :: CameraProjection -> CameraProjection -> [CameraProjection]
$cenumFromTo :: CameraProjection -> CameraProjection -> [CameraProjection]
enumFromThen :: CameraProjection -> CameraProjection -> [CameraProjection]
$cenumFromThen :: CameraProjection -> CameraProjection -> [CameraProjection]
enumFrom :: CameraProjection -> [CameraProjection]
$cenumFrom :: CameraProjection -> [CameraProjection]
fromEnum :: CameraProjection -> Int
$cfromEnum :: CameraProjection -> Int
toEnum :: Int -> CameraProjection
$ctoEnum :: Int -> CameraProjection
pred :: CameraProjection -> CameraProjection
$cpred :: CameraProjection -> CameraProjection
succ :: CameraProjection -> CameraProjection
$csucc :: CameraProjection -> CameraProjection
Enum)

instance Storable CameraProjection where
  sizeOf :: CameraProjection -> Int
sizeOf CameraProjection
_ = Int
4
  alignment :: CameraProjection -> Int
alignment CameraProjection
_ = Int
4
  peek :: Ptr CameraProjection -> IO CameraProjection
peek Ptr CameraProjection
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr CameraProjection
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt))
  poke :: Ptr CameraProjection -> CameraProjection -> IO ()
poke Ptr CameraProjection
ptr CameraProjection
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr CameraProjection
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum CameraProjection
v) :: CInt)

data NPatchLayout = NPatchNinePatch | NPatchThreePatchVertical | NPatchThreePatchHorizontal deriving (NPatchLayout -> NPatchLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NPatchLayout -> NPatchLayout -> Bool
$c/= :: NPatchLayout -> NPatchLayout -> Bool
== :: NPatchLayout -> NPatchLayout -> Bool
$c== :: NPatchLayout -> NPatchLayout -> Bool
Eq, Int -> NPatchLayout -> ShowS
[NPatchLayout] -> ShowS
NPatchLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NPatchLayout] -> ShowS
$cshowList :: [NPatchLayout] -> ShowS
show :: NPatchLayout -> String
$cshow :: NPatchLayout -> String
showsPrec :: Int -> NPatchLayout -> ShowS
$cshowsPrec :: Int -> NPatchLayout -> ShowS
Show, Int -> NPatchLayout
NPatchLayout -> Int
NPatchLayout -> [NPatchLayout]
NPatchLayout -> NPatchLayout
NPatchLayout -> NPatchLayout -> [NPatchLayout]
NPatchLayout -> NPatchLayout -> NPatchLayout -> [NPatchLayout]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NPatchLayout -> NPatchLayout -> NPatchLayout -> [NPatchLayout]
$cenumFromThenTo :: NPatchLayout -> NPatchLayout -> NPatchLayout -> [NPatchLayout]
enumFromTo :: NPatchLayout -> NPatchLayout -> [NPatchLayout]
$cenumFromTo :: NPatchLayout -> NPatchLayout -> [NPatchLayout]
enumFromThen :: NPatchLayout -> NPatchLayout -> [NPatchLayout]
$cenumFromThen :: NPatchLayout -> NPatchLayout -> [NPatchLayout]
enumFrom :: NPatchLayout -> [NPatchLayout]
$cenumFrom :: NPatchLayout -> [NPatchLayout]
fromEnum :: NPatchLayout -> Int
$cfromEnum :: NPatchLayout -> Int
toEnum :: Int -> NPatchLayout
$ctoEnum :: Int -> NPatchLayout
pred :: NPatchLayout -> NPatchLayout
$cpred :: NPatchLayout -> NPatchLayout
succ :: NPatchLayout -> NPatchLayout
$csucc :: NPatchLayout -> NPatchLayout
Enum)

instance Storable NPatchLayout where
  sizeOf :: NPatchLayout -> Int
sizeOf NPatchLayout
_ = Int
4
  alignment :: NPatchLayout -> Int
alignment NPatchLayout
_ = Int
4
  peek :: Ptr NPatchLayout -> IO NPatchLayout
peek Ptr NPatchLayout
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr NPatchLayout
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr NPatchLayout -> NPatchLayout -> IO ()
poke Ptr NPatchLayout
ptr NPatchLayout
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr NPatchLayout
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum NPatchLayout
v) :: CInt)

data MusicContextType
  = MusicAudioNone
  | MusicAudioWAV
  | MusicAudioOGG
  | MusicAudioFLAC
  | MusicAudioMP3
  | MusicAudioQOA
  | MusicModuleXM
  | MusicModuleMOD
  deriving (MusicContextType -> MusicContextType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MusicContextType -> MusicContextType -> Bool
$c/= :: MusicContextType -> MusicContextType -> Bool
== :: MusicContextType -> MusicContextType -> Bool
$c== :: MusicContextType -> MusicContextType -> Bool
Eq, Int -> MusicContextType -> ShowS
[MusicContextType] -> ShowS
MusicContextType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MusicContextType] -> ShowS
$cshowList :: [MusicContextType] -> ShowS
show :: MusicContextType -> String
$cshow :: MusicContextType -> String
showsPrec :: Int -> MusicContextType -> ShowS
$cshowsPrec :: Int -> MusicContextType -> ShowS
Show, Int -> MusicContextType
MusicContextType -> Int
MusicContextType -> [MusicContextType]
MusicContextType -> MusicContextType
MusicContextType -> MusicContextType -> [MusicContextType]
MusicContextType
-> MusicContextType -> MusicContextType -> [MusicContextType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MusicContextType
-> MusicContextType -> MusicContextType -> [MusicContextType]
$cenumFromThenTo :: MusicContextType
-> MusicContextType -> MusicContextType -> [MusicContextType]
enumFromTo :: MusicContextType -> MusicContextType -> [MusicContextType]
$cenumFromTo :: MusicContextType -> MusicContextType -> [MusicContextType]
enumFromThen :: MusicContextType -> MusicContextType -> [MusicContextType]
$cenumFromThen :: MusicContextType -> MusicContextType -> [MusicContextType]
enumFrom :: MusicContextType -> [MusicContextType]
$cenumFrom :: MusicContextType -> [MusicContextType]
fromEnum :: MusicContextType -> Int
$cfromEnum :: MusicContextType -> Int
toEnum :: Int -> MusicContextType
$ctoEnum :: Int -> MusicContextType
pred :: MusicContextType -> MusicContextType
$cpred :: MusicContextType -> MusicContextType
succ :: MusicContextType -> MusicContextType
$csucc :: MusicContextType -> MusicContextType
Enum)

instance Storable MusicContextType where
  sizeOf :: MusicContextType -> Int
sizeOf MusicContextType
_ = Int
4
  alignment :: MusicContextType -> Int
alignment MusicContextType
_ = Int
4
  peek :: Ptr MusicContextType -> IO MusicContextType
peek Ptr MusicContextType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr MusicContextType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr MusicContextType -> MusicContextType -> IO ()
poke Ptr MusicContextType
ptr MusicContextType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr MusicContextType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum MusicContextType
v) :: CInt)

---- rlgl.h


-- | OpenGL version

data RLGLVersion
  = -- | OpenGL 1.1

    RLOpenGL11
  | -- | OpenGL 2.1 (GLSL 120)

    RLOpenGL21
  | -- | OpenGL 3.3 (GLSL 330)

    RLOpenGL33
  | -- | OpenGL 4.3 (using GLSL 330)

    RLOpenGL43
  | -- | OpenGL ES 2.0 (GLSL 100)

    RLOpenGLES20
  deriving (RLGLVersion -> RLGLVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLGLVersion -> RLGLVersion -> Bool
$c/= :: RLGLVersion -> RLGLVersion -> Bool
== :: RLGLVersion -> RLGLVersion -> Bool
$c== :: RLGLVersion -> RLGLVersion -> Bool
Eq, Int -> RLGLVersion -> ShowS
[RLGLVersion] -> ShowS
RLGLVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLGLVersion] -> ShowS
$cshowList :: [RLGLVersion] -> ShowS
show :: RLGLVersion -> String
$cshow :: RLGLVersion -> String
showsPrec :: Int -> RLGLVersion -> ShowS
$cshowsPrec :: Int -> RLGLVersion -> ShowS
Show)

instance Enum RLGLVersion where
  fromEnum :: RLGLVersion -> Int
fromEnum RLGLVersion
n = case RLGLVersion
n of
    RLGLVersion
RLOpenGL11 -> Int
0
    RLGLVersion
RLOpenGL21 -> Int
1
    RLGLVersion
RLOpenGL33 -> Int
2
    RLGLVersion
RLOpenGL43 -> Int
3
    RLGLVersion
RLOpenGLES20 -> Int
4
  toEnum :: Int -> RLGLVersion
toEnum Int
n = case Int
n of
    Int
0 -> RLGLVersion
RLOpenGL11
    Int
1 -> RLGLVersion
RLOpenGL21
    Int
2 -> RLGLVersion
RLOpenGL33
    Int
3 -> RLGLVersion
RLOpenGL43
    Int
4 -> RLGLVersion
RLOpenGLES20
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLGLVersion.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLGLVersion where
  sizeOf :: RLGLVersion -> Int
sizeOf RLGLVersion
_ = Int
4
  alignment :: RLGLVersion -> Int
alignment RLGLVersion
_ = Int
4
  peek :: Ptr RLGLVersion -> IO RLGLVersion
peek Ptr RLGLVersion
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLGLVersion
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLGLVersion -> RLGLVersion -> IO ()
poke Ptr RLGLVersion
ptr RLGLVersion
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLGLVersion
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLGLVersion
v) :: CInt)

-- | Trace log level.

-- NOTE: Organized by priority level

data RLTraceLogLevel
  = -- | Display all logs

    RLLogAll
  | -- | Trace logging, intended for internal use only

    RLLogTrace
  | -- | Debug logging, used for internal debugging, it should be disabled on release builds

    RLLogDebug
  | -- | Info logging, used for program execution info

    RLLogInfo
  | -- | Warning logging, used on recoverable failures

    RLLogWarning
  | -- | Error logging, used on unrecoverable failures

    RLLogError
  | -- | Fatal logging, used to abort program: exit(EXIT_FAILURE)

    RLLogFatal
  | -- | Disable logging

    RLLogNone
  deriving (RLTraceLogLevel -> RLTraceLogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLTraceLogLevel -> RLTraceLogLevel -> Bool
$c/= :: RLTraceLogLevel -> RLTraceLogLevel -> Bool
== :: RLTraceLogLevel -> RLTraceLogLevel -> Bool
$c== :: RLTraceLogLevel -> RLTraceLogLevel -> Bool
Eq, Int -> RLTraceLogLevel -> ShowS
[RLTraceLogLevel] -> ShowS
RLTraceLogLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLTraceLogLevel] -> ShowS
$cshowList :: [RLTraceLogLevel] -> ShowS
show :: RLTraceLogLevel -> String
$cshow :: RLTraceLogLevel -> String
showsPrec :: Int -> RLTraceLogLevel -> ShowS
$cshowsPrec :: Int -> RLTraceLogLevel -> ShowS
Show, Int -> RLTraceLogLevel
RLTraceLogLevel -> Int
RLTraceLogLevel -> [RLTraceLogLevel]
RLTraceLogLevel -> RLTraceLogLevel
RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
RLTraceLogLevel
-> RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLTraceLogLevel
-> RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
$cenumFromThenTo :: RLTraceLogLevel
-> RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
enumFromTo :: RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
$cenumFromTo :: RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
enumFromThen :: RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
$cenumFromThen :: RLTraceLogLevel -> RLTraceLogLevel -> [RLTraceLogLevel]
enumFrom :: RLTraceLogLevel -> [RLTraceLogLevel]
$cenumFrom :: RLTraceLogLevel -> [RLTraceLogLevel]
fromEnum :: RLTraceLogLevel -> Int
$cfromEnum :: RLTraceLogLevel -> Int
toEnum :: Int -> RLTraceLogLevel
$ctoEnum :: Int -> RLTraceLogLevel
pred :: RLTraceLogLevel -> RLTraceLogLevel
$cpred :: RLTraceLogLevel -> RLTraceLogLevel
succ :: RLTraceLogLevel -> RLTraceLogLevel
$csucc :: RLTraceLogLevel -> RLTraceLogLevel
Enum)

instance Storable RLTraceLogLevel where
  sizeOf :: RLTraceLogLevel -> Int
sizeOf RLTraceLogLevel
_ = Int
4
  alignment :: RLTraceLogLevel -> Int
alignment RLTraceLogLevel
_ = Int
4
  peek :: Ptr RLTraceLogLevel -> IO RLTraceLogLevel
peek Ptr RLTraceLogLevel
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTraceLogLevel
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLTraceLogLevel -> RLTraceLogLevel -> IO ()
poke Ptr RLTraceLogLevel
ptr RLTraceLogLevel
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTraceLogLevel
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLTraceLogLevel
v) :: CInt)

-- | Texture pixel formats.

-- NOTE: Support depends on OpenGL version

data RLPixelFormat
  = -- | 8 bit per pixel (no alpha)

    RLPixelFormatUncompressedGrayscale
  | -- | 8*2 bpp (2 channels)

    RLPixelFormatUncompressedGrayAlpha
  | -- | 16 bpp

    RLPixelFormatUncompressedR5G6B5
  | -- | 24 bpp

    RLPixelFormatUncompressedR8G8B8
  | -- | 16 bpp (1 bit alpha)

    RLPixelFormatUncompressedR5G5B5A1
  | -- | 16 bpp (4 bit alpha)

    RLPixelFormatUncompressedR4G4B4A4
  | -- | 32 bpp

    RLPixelFormatUncompressedR8G8B8A8
  | -- | 32 bpp (1 channel - float)

    RLPixelFormatUncompressedR32
  | -- | 32*3 bpp (3 channels - float)

    RLPixelFormatUncompressedR32G32B32
  | -- | 32*4 bpp (4 channels - float)

    RLPixelFormatUncompressedR32G32B32A32
  | -- | 4 bpp (no alpha)

    RLPixelFormatCompressedDxt1Rgb
  | -- | 4 bpp (1 bit alpha)

    RLPixelFormatCompressedDxt1Rgba
  | -- | 8 bpp

    RLPixelFormatCompressedDxt3Rgba
  | -- | 8 bpp

    RLPixelFormatCompressedDxt5Rgba
  | -- | 4 bpp

    RLPixelFormatCompressedEtc1Rgb
  | -- | 4 bpp

    RLPixelFormatCompressedEtc2Rgb
  | -- | 8 bpp

    RLPixelFormatCompressedEtc2EacRgba
  | -- | 4 bpp

    RLPixelFormatCompressedPvrtRgb
  | -- | 4 bpp

    RLPixelFormatCompressedPvrtRgba
  | -- | 8 bpp

    RLPixelFormatCompressedAstc4x4Rgba
  | -- | 2 bpp

    RLPixelFormatCompressedAstc8x8Rgba
  deriving (RLPixelFormat -> RLPixelFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLPixelFormat -> RLPixelFormat -> Bool
$c/= :: RLPixelFormat -> RLPixelFormat -> Bool
== :: RLPixelFormat -> RLPixelFormat -> Bool
$c== :: RLPixelFormat -> RLPixelFormat -> Bool
Eq, Int -> RLPixelFormat -> ShowS
[RLPixelFormat] -> ShowS
RLPixelFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLPixelFormat] -> ShowS
$cshowList :: [RLPixelFormat] -> ShowS
show :: RLPixelFormat -> String
$cshow :: RLPixelFormat -> String
showsPrec :: Int -> RLPixelFormat -> ShowS
$cshowsPrec :: Int -> RLPixelFormat -> ShowS
Show)

instance Enum RLPixelFormat where
  fromEnum :: RLPixelFormat -> Int
fromEnum RLPixelFormat
n = case RLPixelFormat
n of
    RLPixelFormat
RLPixelFormatUncompressedGrayscale -> Int
1
    RLPixelFormat
RLPixelFormatUncompressedGrayAlpha -> Int
2
    RLPixelFormat
RLPixelFormatUncompressedR5G6B5 -> Int
3
    RLPixelFormat
RLPixelFormatUncompressedR8G8B8 -> Int
4
    RLPixelFormat
RLPixelFormatUncompressedR5G5B5A1 -> Int
5
    RLPixelFormat
RLPixelFormatUncompressedR4G4B4A4 -> Int
6
    RLPixelFormat
RLPixelFormatUncompressedR8G8B8A8 -> Int
7
    RLPixelFormat
RLPixelFormatUncompressedR32 -> Int
8
    RLPixelFormat
RLPixelFormatUncompressedR32G32B32 -> Int
9
    RLPixelFormat
RLPixelFormatUncompressedR32G32B32A32 -> Int
10
    RLPixelFormat
RLPixelFormatCompressedDxt1Rgb -> Int
11
    RLPixelFormat
RLPixelFormatCompressedDxt1Rgba -> Int
12
    RLPixelFormat
RLPixelFormatCompressedDxt3Rgba -> Int
13
    RLPixelFormat
RLPixelFormatCompressedDxt5Rgba -> Int
14
    RLPixelFormat
RLPixelFormatCompressedEtc1Rgb -> Int
15
    RLPixelFormat
RLPixelFormatCompressedEtc2Rgb -> Int
16
    RLPixelFormat
RLPixelFormatCompressedEtc2EacRgba -> Int
17
    RLPixelFormat
RLPixelFormatCompressedPvrtRgb -> Int
18
    RLPixelFormat
RLPixelFormatCompressedPvrtRgba -> Int
19
    RLPixelFormat
RLPixelFormatCompressedAstc4x4Rgba -> Int
20
    RLPixelFormat
RLPixelFormatCompressedAstc8x8Rgba -> Int
21

  toEnum :: Int -> RLPixelFormat
toEnum Int
n = case Int
n of
    Int
1 -> RLPixelFormat
RLPixelFormatUncompressedGrayscale
    Int
2 -> RLPixelFormat
RLPixelFormatUncompressedGrayAlpha
    Int
3 -> RLPixelFormat
RLPixelFormatUncompressedR5G6B5
    Int
4 -> RLPixelFormat
RLPixelFormatUncompressedR8G8B8
    Int
5 -> RLPixelFormat
RLPixelFormatUncompressedR5G5B5A1
    Int
6 -> RLPixelFormat
RLPixelFormatUncompressedR4G4B4A4
    Int
7 -> RLPixelFormat
RLPixelFormatUncompressedR8G8B8A8
    Int
8 -> RLPixelFormat
RLPixelFormatUncompressedR32
    Int
9 -> RLPixelFormat
RLPixelFormatUncompressedR32G32B32
    Int
10 -> RLPixelFormat
RLPixelFormatUncompressedR32G32B32A32
    Int
11 -> RLPixelFormat
RLPixelFormatCompressedDxt1Rgb
    Int
12 -> RLPixelFormat
RLPixelFormatCompressedDxt1Rgba
    Int
13 -> RLPixelFormat
RLPixelFormatCompressedDxt3Rgba
    Int
14 -> RLPixelFormat
RLPixelFormatCompressedDxt5Rgba
    Int
15 -> RLPixelFormat
RLPixelFormatCompressedEtc1Rgb
    Int
16 -> RLPixelFormat
RLPixelFormatCompressedEtc2Rgb
    Int
17 -> RLPixelFormat
RLPixelFormatCompressedEtc2EacRgba
    Int
18 -> RLPixelFormat
RLPixelFormatCompressedPvrtRgb
    Int
19 -> RLPixelFormat
RLPixelFormatCompressedPvrtRgba
    Int
20 -> RLPixelFormat
RLPixelFormatCompressedAstc4x4Rgba
    Int
21 -> RLPixelFormat
RLPixelFormatCompressedAstc8x8Rgba
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLPixelFormat.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLPixelFormat where
  sizeOf :: RLPixelFormat -> Int
sizeOf RLPixelFormat
_ = Int
4
  alignment :: RLPixelFormat -> Int
alignment RLPixelFormat
_ = Int
4
  peek :: Ptr RLPixelFormat -> IO RLPixelFormat
peek Ptr RLPixelFormat
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLPixelFormat
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLPixelFormat -> RLPixelFormat -> IO ()
poke Ptr RLPixelFormat
ptr RLPixelFormat
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLPixelFormat
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLPixelFormat
v) :: CInt)

-- | Texture parameters: filter mode.

-- NOTE 1: Filtering considers mipmaps if available in the texture.

-- NOTE 2: Filter is accordingly set for minification and magnification.

data RLTextureFilter
  = -- | No filter, just pixel approximation

    RLTextureFilterPoint
  | -- | Linear filtering

    RLTextureFilterBilinear
  | -- | Trilinear filtering (linear with mipmaps)

    RLTextureFilterTrilinear
  | -- | Anisotropic filtering 4x

    RLTextureFilterAnisotropic4x
  | -- | Anisotropic filtering 8x

    RLTextureFilterAnisotropic8x
  | -- | Anisotropic filtering 16x

    RLTextureFilterAnisotropic16x
  deriving (RLTextureFilter -> RLTextureFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLTextureFilter -> RLTextureFilter -> Bool
$c/= :: RLTextureFilter -> RLTextureFilter -> Bool
== :: RLTextureFilter -> RLTextureFilter -> Bool
$c== :: RLTextureFilter -> RLTextureFilter -> Bool
Eq, Int -> RLTextureFilter -> ShowS
[RLTextureFilter] -> ShowS
RLTextureFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLTextureFilter] -> ShowS
$cshowList :: [RLTextureFilter] -> ShowS
show :: RLTextureFilter -> String
$cshow :: RLTextureFilter -> String
showsPrec :: Int -> RLTextureFilter -> ShowS
$cshowsPrec :: Int -> RLTextureFilter -> ShowS
Show, Int -> RLTextureFilter
RLTextureFilter -> Int
RLTextureFilter -> [RLTextureFilter]
RLTextureFilter -> RLTextureFilter
RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
RLTextureFilter
-> RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLTextureFilter
-> RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
$cenumFromThenTo :: RLTextureFilter
-> RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
enumFromTo :: RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
$cenumFromTo :: RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
enumFromThen :: RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
$cenumFromThen :: RLTextureFilter -> RLTextureFilter -> [RLTextureFilter]
enumFrom :: RLTextureFilter -> [RLTextureFilter]
$cenumFrom :: RLTextureFilter -> [RLTextureFilter]
fromEnum :: RLTextureFilter -> Int
$cfromEnum :: RLTextureFilter -> Int
toEnum :: Int -> RLTextureFilter
$ctoEnum :: Int -> RLTextureFilter
pred :: RLTextureFilter -> RLTextureFilter
$cpred :: RLTextureFilter -> RLTextureFilter
succ :: RLTextureFilter -> RLTextureFilter
$csucc :: RLTextureFilter -> RLTextureFilter
Enum)

instance Storable RLTextureFilter where
  sizeOf :: RLTextureFilter -> Int
sizeOf RLTextureFilter
_ = Int
4
  alignment :: RLTextureFilter -> Int
alignment RLTextureFilter
_ = Int
4
  peek :: Ptr RLTextureFilter -> IO RLTextureFilter
peek Ptr RLTextureFilter
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTextureFilter
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLTextureFilter -> RLTextureFilter -> IO ()
poke Ptr RLTextureFilter
ptr RLTextureFilter
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTextureFilter
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLTextureFilter
v) :: CInt)

-- | Color blending modes (pre-defined)

data RLBlendMode
  = -- | Blend textures considering alpha (default)

    RlBlendAlpha
  | -- | Blend textures adding colors

    RlBlendAdditive
  | -- | Blend textures multiplying colors

    RlBlendMultiplied
  | -- | Blend textures adding colors (alternative)

    RlBlendAddColors
  | -- | Blend textures subtracting colors (alternative)

    RlBlendSubtractColors
  | -- | Blend premultiplied textures considering alpha

    RlBlendAlphaPremultiply
  | -- | Blend textures using custom src/dst factors (use rlSetBlendFactors())

    RlBlendCustom
  | -- | Blend textures using custom src/dst factors (use rlSetBlendFactorsSeparate())

    RlBlendCustomSeparate
  deriving (RLBlendMode -> RLBlendMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLBlendMode -> RLBlendMode -> Bool
$c/= :: RLBlendMode -> RLBlendMode -> Bool
== :: RLBlendMode -> RLBlendMode -> Bool
$c== :: RLBlendMode -> RLBlendMode -> Bool
Eq, Int -> RLBlendMode -> ShowS
[RLBlendMode] -> ShowS
RLBlendMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLBlendMode] -> ShowS
$cshowList :: [RLBlendMode] -> ShowS
show :: RLBlendMode -> String
$cshow :: RLBlendMode -> String
showsPrec :: Int -> RLBlendMode -> ShowS
$cshowsPrec :: Int -> RLBlendMode -> ShowS
Show, Int -> RLBlendMode
RLBlendMode -> Int
RLBlendMode -> [RLBlendMode]
RLBlendMode -> RLBlendMode
RLBlendMode -> RLBlendMode -> [RLBlendMode]
RLBlendMode -> RLBlendMode -> RLBlendMode -> [RLBlendMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLBlendMode -> RLBlendMode -> RLBlendMode -> [RLBlendMode]
$cenumFromThenTo :: RLBlendMode -> RLBlendMode -> RLBlendMode -> [RLBlendMode]
enumFromTo :: RLBlendMode -> RLBlendMode -> [RLBlendMode]
$cenumFromTo :: RLBlendMode -> RLBlendMode -> [RLBlendMode]
enumFromThen :: RLBlendMode -> RLBlendMode -> [RLBlendMode]
$cenumFromThen :: RLBlendMode -> RLBlendMode -> [RLBlendMode]
enumFrom :: RLBlendMode -> [RLBlendMode]
$cenumFrom :: RLBlendMode -> [RLBlendMode]
fromEnum :: RLBlendMode -> Int
$cfromEnum :: RLBlendMode -> Int
toEnum :: Int -> RLBlendMode
$ctoEnum :: Int -> RLBlendMode
pred :: RLBlendMode -> RLBlendMode
$cpred :: RLBlendMode -> RLBlendMode
succ :: RLBlendMode -> RLBlendMode
$csucc :: RLBlendMode -> RLBlendMode
Enum)

instance Storable RLBlendMode where
  sizeOf :: RLBlendMode -> Int
sizeOf RLBlendMode
_ = Int
4
  alignment :: RLBlendMode -> Int
alignment RLBlendMode
_ = Int
4
  peek :: Ptr RLBlendMode -> IO RLBlendMode
peek Ptr RLBlendMode
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLBlendMode
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLBlendMode -> RLBlendMode -> IO ()
poke Ptr RLBlendMode
ptr RLBlendMode
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLBlendMode
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLBlendMode
v) :: CInt)

-- | Shader location point type

data RLShaderLocationIndex
  = -- | Shader location: vertex attribute: position

    RLShaderLocVertexPosition
  | -- | Shader location: vertex attribute: texcoord01

    RLShaderLocVertexTexcoord01
  | -- | Shader location: vertex attribute: texcoord02

    RLShaderLocVertexTexcoord02
  | -- | Shader location: vertex attribute: normal

    RLShaderLocVertexNormal
  | -- | Shader location: vertex attribute: tangent

    RLShaderLocVertexTangent
  | -- | Shader location: vertex attribute: color

    RLShaderLocVertexColor
  | -- | Shader location: matrix uniform: model-view-projection

    RLShaderLocMatrixMVP
  | -- | Shader location: matrix uniform: view (camera transform)

    RLShaderLocMatrixView
  | -- | Shader location: matrix uniform: projection

    RLShaderLocMatrixProjection
  | -- | Shader location: matrix uniform: model (transform)

    RLShaderLocMatrixModel
  | -- | Shader location: matrix uniform: normal

    RLShaderLocMatrixNormal
  | -- | Shader location: vector uniform: view

    RLShaderLocVectorView
  | -- | Shader location: vector uniform: diffuse color

    RLShaderLocColorDiffuse
  | -- | Shader location: vector uniform: specular color

    RLShaderLocColorSpecular
  | -- | Shader location: vector uniform: ambient color

    RLShaderLocColorAmbient
  | -- | Shader location: sampler2d texture: albedo (same as: RL_SHADER_LOC_MAP_DIFFUSE)

    RLShaderLocMapAlbedo
  | -- | Shader location: sampler2d texture: metalness (same as: RL_SHADER_LOC_MAP_SPECULAR)

    RLShaderLocMapMetalness
  | -- | Shader location: sampler2d texture: normal

    RLShaderLocMapNormal
  | -- | Shader location: sampler2d texture: roughness

    RLShaderLocMapRoughness
  | -- | Shader location: sampler2d texture: occlusion

    RLShaderLocMapOcclusion
  | -- | Shader location: sampler2d texture: emission

    RLShaderLocMapEmission
  | -- | Shader location: sampler2d texture: height

    RLShaderLocMapHeight
  | -- | Shader location: samplerCube texture: cubemap

    RLShaderLocMapCubemap
  | -- | Shader location: samplerCube texture: irradiance

    RLShaderLocMapIrradiance
  | -- | Shader location: samplerCube texture: prefilter

    RLShaderLocMapPrefilter
  | -- | Shader location: sampler2d texture: brdf

    RLShaderLocMapBRDF
  deriving (RLShaderLocationIndex -> RLShaderLocationIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLShaderLocationIndex -> RLShaderLocationIndex -> Bool
$c/= :: RLShaderLocationIndex -> RLShaderLocationIndex -> Bool
== :: RLShaderLocationIndex -> RLShaderLocationIndex -> Bool
$c== :: RLShaderLocationIndex -> RLShaderLocationIndex -> Bool
Eq, Int -> RLShaderLocationIndex -> ShowS
[RLShaderLocationIndex] -> ShowS
RLShaderLocationIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLShaderLocationIndex] -> ShowS
$cshowList :: [RLShaderLocationIndex] -> ShowS
show :: RLShaderLocationIndex -> String
$cshow :: RLShaderLocationIndex -> String
showsPrec :: Int -> RLShaderLocationIndex -> ShowS
$cshowsPrec :: Int -> RLShaderLocationIndex -> ShowS
Show, Int -> RLShaderLocationIndex
RLShaderLocationIndex -> Int
RLShaderLocationIndex -> [RLShaderLocationIndex]
RLShaderLocationIndex -> RLShaderLocationIndex
RLShaderLocationIndex
-> RLShaderLocationIndex -> [RLShaderLocationIndex]
RLShaderLocationIndex
-> RLShaderLocationIndex
-> RLShaderLocationIndex
-> [RLShaderLocationIndex]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLShaderLocationIndex
-> RLShaderLocationIndex
-> RLShaderLocationIndex
-> [RLShaderLocationIndex]
$cenumFromThenTo :: RLShaderLocationIndex
-> RLShaderLocationIndex
-> RLShaderLocationIndex
-> [RLShaderLocationIndex]
enumFromTo :: RLShaderLocationIndex
-> RLShaderLocationIndex -> [RLShaderLocationIndex]
$cenumFromTo :: RLShaderLocationIndex
-> RLShaderLocationIndex -> [RLShaderLocationIndex]
enumFromThen :: RLShaderLocationIndex
-> RLShaderLocationIndex -> [RLShaderLocationIndex]
$cenumFromThen :: RLShaderLocationIndex
-> RLShaderLocationIndex -> [RLShaderLocationIndex]
enumFrom :: RLShaderLocationIndex -> [RLShaderLocationIndex]
$cenumFrom :: RLShaderLocationIndex -> [RLShaderLocationIndex]
fromEnum :: RLShaderLocationIndex -> Int
$cfromEnum :: RLShaderLocationIndex -> Int
toEnum :: Int -> RLShaderLocationIndex
$ctoEnum :: Int -> RLShaderLocationIndex
pred :: RLShaderLocationIndex -> RLShaderLocationIndex
$cpred :: RLShaderLocationIndex -> RLShaderLocationIndex
succ :: RLShaderLocationIndex -> RLShaderLocationIndex
$csucc :: RLShaderLocationIndex -> RLShaderLocationIndex
Enum)

instance Storable RLShaderLocationIndex where
  sizeOf :: RLShaderLocationIndex -> Int
sizeOf RLShaderLocationIndex
_ = Int
4
  alignment :: RLShaderLocationIndex -> Int
alignment RLShaderLocationIndex
_ = Int
4
  peek :: Ptr RLShaderLocationIndex -> IO RLShaderLocationIndex
peek Ptr RLShaderLocationIndex
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderLocationIndex
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLShaderLocationIndex -> RLShaderLocationIndex -> IO ()
poke Ptr RLShaderLocationIndex
ptr RLShaderLocationIndex
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderLocationIndex
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLShaderLocationIndex
v) :: CInt)

-- | Shader uniform data type

data RLShaderUniformDataType
  = -- | Shader uniform type: float

    RLShaderUniformFloat
  | -- | Shader uniform type: vec2 (2 float)

    RLShaderUniformVec2
  | -- | Shader uniform type: vec3 (3 float)

    RLShaderUniformVec3
  | -- | Shader uniform type: vec4 (4 float)

    RLShaderUniformVec4
  | -- | Shader uniform type: int

    RLShaderUniformInt
  | -- | Shader uniform type: ivec2 (2 int)

    RLShaderUniformIVec2
  | -- | Shader uniform type: ivec3 (3 int)

    RLShaderUniformIVec3
  | -- | Shader uniform type: ivec4 (4 int)

    RLShaderUniformIVec4
  | -- | Shader uniform type: sampler2d

    RLShaderUniformSampler2D
  deriving (RLShaderUniformDataType -> RLShaderUniformDataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLShaderUniformDataType -> RLShaderUniformDataType -> Bool
$c/= :: RLShaderUniformDataType -> RLShaderUniformDataType -> Bool
== :: RLShaderUniformDataType -> RLShaderUniformDataType -> Bool
$c== :: RLShaderUniformDataType -> RLShaderUniformDataType -> Bool
Eq, Int -> RLShaderUniformDataType -> ShowS
[RLShaderUniformDataType] -> ShowS
RLShaderUniformDataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLShaderUniformDataType] -> ShowS
$cshowList :: [RLShaderUniformDataType] -> ShowS
show :: RLShaderUniformDataType -> String
$cshow :: RLShaderUniformDataType -> String
showsPrec :: Int -> RLShaderUniformDataType -> ShowS
$cshowsPrec :: Int -> RLShaderUniformDataType -> ShowS
Show, Int -> RLShaderUniformDataType
RLShaderUniformDataType -> Int
RLShaderUniformDataType -> [RLShaderUniformDataType]
RLShaderUniformDataType -> RLShaderUniformDataType
RLShaderUniformDataType
-> RLShaderUniformDataType -> [RLShaderUniformDataType]
RLShaderUniformDataType
-> RLShaderUniformDataType
-> RLShaderUniformDataType
-> [RLShaderUniformDataType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLShaderUniformDataType
-> RLShaderUniformDataType
-> RLShaderUniformDataType
-> [RLShaderUniformDataType]
$cenumFromThenTo :: RLShaderUniformDataType
-> RLShaderUniformDataType
-> RLShaderUniformDataType
-> [RLShaderUniformDataType]
enumFromTo :: RLShaderUniformDataType
-> RLShaderUniformDataType -> [RLShaderUniformDataType]
$cenumFromTo :: RLShaderUniformDataType
-> RLShaderUniformDataType -> [RLShaderUniformDataType]
enumFromThen :: RLShaderUniformDataType
-> RLShaderUniformDataType -> [RLShaderUniformDataType]
$cenumFromThen :: RLShaderUniformDataType
-> RLShaderUniformDataType -> [RLShaderUniformDataType]
enumFrom :: RLShaderUniformDataType -> [RLShaderUniformDataType]
$cenumFrom :: RLShaderUniformDataType -> [RLShaderUniformDataType]
fromEnum :: RLShaderUniformDataType -> Int
$cfromEnum :: RLShaderUniformDataType -> Int
toEnum :: Int -> RLShaderUniformDataType
$ctoEnum :: Int -> RLShaderUniformDataType
pred :: RLShaderUniformDataType -> RLShaderUniformDataType
$cpred :: RLShaderUniformDataType -> RLShaderUniformDataType
succ :: RLShaderUniformDataType -> RLShaderUniformDataType
$csucc :: RLShaderUniformDataType -> RLShaderUniformDataType
Enum)

instance Storable RLShaderUniformDataType where
  sizeOf :: RLShaderUniformDataType -> Int
sizeOf RLShaderUniformDataType
_ = Int
4
  alignment :: RLShaderUniformDataType -> Int
alignment RLShaderUniformDataType
_ = Int
4
  peek :: Ptr RLShaderUniformDataType -> IO RLShaderUniformDataType
peek Ptr RLShaderUniformDataType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderUniformDataType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLShaderUniformDataType -> RLShaderUniformDataType -> IO ()
poke Ptr RLShaderUniformDataType
ptr RLShaderUniformDataType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderUniformDataType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLShaderUniformDataType
v) :: CInt)

-- | Shader attribute data types

data RLShaderAttributeDataType
  = -- | Shader attribute type: float

    RLShaderAttribFloat
  | -- | Shader attribute type: vec2 (2 float)

    RLShaderAttribVec2
  | -- | Shader attribute type: vec3 (3 float)

    RLShaderAttribVec3
  | -- | Shader attribute type: vec4 (4 float)

    RLShaderAttribVec4
  deriving (RLShaderAttributeDataType -> RLShaderAttributeDataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLShaderAttributeDataType -> RLShaderAttributeDataType -> Bool
$c/= :: RLShaderAttributeDataType -> RLShaderAttributeDataType -> Bool
== :: RLShaderAttributeDataType -> RLShaderAttributeDataType -> Bool
$c== :: RLShaderAttributeDataType -> RLShaderAttributeDataType -> Bool
Eq, Int -> RLShaderAttributeDataType -> ShowS
[RLShaderAttributeDataType] -> ShowS
RLShaderAttributeDataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLShaderAttributeDataType] -> ShowS
$cshowList :: [RLShaderAttributeDataType] -> ShowS
show :: RLShaderAttributeDataType -> String
$cshow :: RLShaderAttributeDataType -> String
showsPrec :: Int -> RLShaderAttributeDataType -> ShowS
$cshowsPrec :: Int -> RLShaderAttributeDataType -> ShowS
Show, Int -> RLShaderAttributeDataType
RLShaderAttributeDataType -> Int
RLShaderAttributeDataType -> [RLShaderAttributeDataType]
RLShaderAttributeDataType -> RLShaderAttributeDataType
RLShaderAttributeDataType
-> RLShaderAttributeDataType -> [RLShaderAttributeDataType]
RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> [RLShaderAttributeDataType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> [RLShaderAttributeDataType]
$cenumFromThenTo :: RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> RLShaderAttributeDataType
-> [RLShaderAttributeDataType]
enumFromTo :: RLShaderAttributeDataType
-> RLShaderAttributeDataType -> [RLShaderAttributeDataType]
$cenumFromTo :: RLShaderAttributeDataType
-> RLShaderAttributeDataType -> [RLShaderAttributeDataType]
enumFromThen :: RLShaderAttributeDataType
-> RLShaderAttributeDataType -> [RLShaderAttributeDataType]
$cenumFromThen :: RLShaderAttributeDataType
-> RLShaderAttributeDataType -> [RLShaderAttributeDataType]
enumFrom :: RLShaderAttributeDataType -> [RLShaderAttributeDataType]
$cenumFrom :: RLShaderAttributeDataType -> [RLShaderAttributeDataType]
fromEnum :: RLShaderAttributeDataType -> Int
$cfromEnum :: RLShaderAttributeDataType -> Int
toEnum :: Int -> RLShaderAttributeDataType
$ctoEnum :: Int -> RLShaderAttributeDataType
pred :: RLShaderAttributeDataType -> RLShaderAttributeDataType
$cpred :: RLShaderAttributeDataType -> RLShaderAttributeDataType
succ :: RLShaderAttributeDataType -> RLShaderAttributeDataType
$csucc :: RLShaderAttributeDataType -> RLShaderAttributeDataType
Enum)

instance Storable RLShaderAttributeDataType where
  sizeOf :: RLShaderAttributeDataType -> Int
sizeOf RLShaderAttributeDataType
_ = Int
4
  alignment :: RLShaderAttributeDataType -> Int
alignment RLShaderAttributeDataType
_ = Int
4
  peek :: Ptr RLShaderAttributeDataType -> IO RLShaderAttributeDataType
peek Ptr RLShaderAttributeDataType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderAttributeDataType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLShaderAttributeDataType -> RLShaderAttributeDataType -> IO ()
poke Ptr RLShaderAttributeDataType
ptr RLShaderAttributeDataType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderAttributeDataType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLShaderAttributeDataType
v) :: CInt)

-- | Framebuffer attachment type.

-- NOTE: By default up to 8 color channels are defined, but it can be more

data RLFramebufferAttachType
  = -- | Framebuffer attachment type: color 0

    RLAttachmentColorChannel0
  | -- | Framebuffer attachment type: color 1

    RLAttachmentColorChannel1
  | -- | Framebuffer attachment type: color 2

    RLAttachmentColorChannel2
  | -- | Framebuffer attachment type: color 3

    RLAttachmentColorChannel3
  | -- | Framebuffer attachment type: color 4

    RLAttachmentColorChannel4
  | -- | Framebuffer attachment type: color 5

    RLAttachmentColorChannel5
  | -- | Framebuffer attachment type: color 6

    RLAttachmentColorChannel6
  | -- | Framebuffer attachment type: color 7

    RLAttachmentColorChannel7
  | -- | Framebuffer attachment type: depth

    RLAttachmentDepth
  | -- | Framebuffer attachment type: stencil

    RLAttachmentStencil
  deriving (RLFramebufferAttachType -> RLFramebufferAttachType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLFramebufferAttachType -> RLFramebufferAttachType -> Bool
$c/= :: RLFramebufferAttachType -> RLFramebufferAttachType -> Bool
== :: RLFramebufferAttachType -> RLFramebufferAttachType -> Bool
$c== :: RLFramebufferAttachType -> RLFramebufferAttachType -> Bool
Eq, Int -> RLFramebufferAttachType -> ShowS
[RLFramebufferAttachType] -> ShowS
RLFramebufferAttachType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLFramebufferAttachType] -> ShowS
$cshowList :: [RLFramebufferAttachType] -> ShowS
show :: RLFramebufferAttachType -> String
$cshow :: RLFramebufferAttachType -> String
showsPrec :: Int -> RLFramebufferAttachType -> ShowS
$cshowsPrec :: Int -> RLFramebufferAttachType -> ShowS
Show)

instance Enum RLFramebufferAttachType where
  fromEnum :: RLFramebufferAttachType -> Int
fromEnum RLFramebufferAttachType
n = case RLFramebufferAttachType
n of
    RLFramebufferAttachType
RLAttachmentColorChannel0 -> Int
0
    RLFramebufferAttachType
RLAttachmentColorChannel1 -> Int
1
    RLFramebufferAttachType
RLAttachmentColorChannel2 -> Int
2
    RLFramebufferAttachType
RLAttachmentColorChannel3 -> Int
3
    RLFramebufferAttachType
RLAttachmentColorChannel4 -> Int
4
    RLFramebufferAttachType
RLAttachmentColorChannel5 -> Int
5
    RLFramebufferAttachType
RLAttachmentColorChannel6 -> Int
6
    RLFramebufferAttachType
RLAttachmentColorChannel7 -> Int
7
    RLFramebufferAttachType
RLAttachmentDepth -> Int
100
    RLFramebufferAttachType
RLAttachmentStencil -> Int
200

  toEnum :: Int -> RLFramebufferAttachType
toEnum Int
n = case Int
n of
    Int
0 -> RLFramebufferAttachType
RLAttachmentColorChannel0
    Int
1 -> RLFramebufferAttachType
RLAttachmentColorChannel1
    Int
2 -> RLFramebufferAttachType
RLAttachmentColorChannel2
    Int
3 -> RLFramebufferAttachType
RLAttachmentColorChannel3
    Int
4 -> RLFramebufferAttachType
RLAttachmentColorChannel4
    Int
5 -> RLFramebufferAttachType
RLAttachmentColorChannel5
    Int
6 -> RLFramebufferAttachType
RLAttachmentColorChannel6
    Int
7 -> RLFramebufferAttachType
RLAttachmentColorChannel7
    Int
100 -> RLFramebufferAttachType
RLAttachmentDepth
    Int
200 -> RLFramebufferAttachType
RLAttachmentStencil
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLFramebufferAttachType.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLFramebufferAttachType where
  sizeOf :: RLFramebufferAttachType -> Int
sizeOf RLFramebufferAttachType
_ = Int
4
  alignment :: RLFramebufferAttachType -> Int
alignment RLFramebufferAttachType
_ = Int
4
  peek :: Ptr RLFramebufferAttachType -> IO RLFramebufferAttachType
peek Ptr RLFramebufferAttachType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLFramebufferAttachType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLFramebufferAttachType -> RLFramebufferAttachType -> IO ()
poke Ptr RLFramebufferAttachType
ptr RLFramebufferAttachType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLFramebufferAttachType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachType
v) :: CInt)

-- | Framebuffer texture attachment type

data RLFramebufferAttachTextureType
  = -- | Framebuffer texture attachment type: cubemap, +X side

    RLAttachmentCubemapPositiveX
  | -- | Framebuffer texture attachment type: cubemap, -X side

    RLAttachmentCubemapNegativeX
  | -- | Framebuffer texture attachment type: cubemap, +Y side

    RLAttachmentCubemapPositiveY
  | -- | Framebuffer texture attachment type: cubemap, -Y side

    RLAttachmentCubemapNegativeY
  | -- | Framebuffer texture attachment type: cubemap, +Z side

    RLAttachmentCubemapPositiveZ
  | -- | Framebuffer texture attachment type: cubemap, -Z side

    RLAttachmentCubemapNegativeZ
  | -- | Framebuffer texture attachment type: texture2d

    RLAttachmentTexture2D
  | -- | Framebuffer texture attachment type: renderbuffer

    RLAttachmentRenderBuffer
  deriving (RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> Bool
$c/= :: RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> Bool
== :: RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> Bool
$c== :: RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> Bool
Eq, Int -> RLFramebufferAttachTextureType -> ShowS
[RLFramebufferAttachTextureType] -> ShowS
RLFramebufferAttachTextureType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLFramebufferAttachTextureType] -> ShowS
$cshowList :: [RLFramebufferAttachTextureType] -> ShowS
show :: RLFramebufferAttachTextureType -> String
$cshow :: RLFramebufferAttachTextureType -> String
showsPrec :: Int -> RLFramebufferAttachTextureType -> ShowS
$cshowsPrec :: Int -> RLFramebufferAttachTextureType -> ShowS
Show)

instance Enum RLFramebufferAttachTextureType where
  fromEnum :: RLFramebufferAttachTextureType -> Int
fromEnum RLFramebufferAttachTextureType
n = case RLFramebufferAttachTextureType
n of
    RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveX -> Int
0
    RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeX -> Int
1
    RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveY -> Int
2
    RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeY -> Int
3
    RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveZ -> Int
4
    RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeZ -> Int
5
    RLFramebufferAttachTextureType
RLAttachmentTexture2D -> Int
100
    RLFramebufferAttachTextureType
RLAttachmentRenderBuffer -> Int
200

  toEnum :: Int -> RLFramebufferAttachTextureType
toEnum Int
n = case Int
n of
    Int
0 -> RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveX
    Int
1 -> RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeX
    Int
2 -> RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveY
    Int
3 -> RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeY
    Int
4 -> RLFramebufferAttachTextureType
RLAttachmentCubemapPositiveZ
    Int
5 -> RLFramebufferAttachTextureType
RLAttachmentCubemapNegativeZ
    Int
100 -> RLFramebufferAttachTextureType
RLAttachmentTexture2D
    Int
200 -> RLFramebufferAttachTextureType
RLAttachmentRenderBuffer
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLFramebufferAttachTextureType.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLFramebufferAttachTextureType where
  sizeOf :: RLFramebufferAttachTextureType -> Int
sizeOf RLFramebufferAttachTextureType
_ = Int
4
  alignment :: RLFramebufferAttachTextureType -> Int
alignment RLFramebufferAttachTextureType
_ = Int
4
  peek :: Ptr RLFramebufferAttachTextureType
-> IO RLFramebufferAttachTextureType
peek Ptr RLFramebufferAttachTextureType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLFramebufferAttachTextureType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLFramebufferAttachTextureType
-> RLFramebufferAttachTextureType -> IO ()
poke Ptr RLFramebufferAttachTextureType
ptr RLFramebufferAttachTextureType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLFramebufferAttachTextureType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLFramebufferAttachTextureType
v) :: CInt)

-- | Face culling mode

data RLCullMode
  = RLCullFaceFront
  | RLCullFaceBack
  deriving (RLCullMode -> RLCullMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLCullMode -> RLCullMode -> Bool
$c/= :: RLCullMode -> RLCullMode -> Bool
== :: RLCullMode -> RLCullMode -> Bool
$c== :: RLCullMode -> RLCullMode -> Bool
Eq, Int -> RLCullMode -> ShowS
[RLCullMode] -> ShowS
RLCullMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLCullMode] -> ShowS
$cshowList :: [RLCullMode] -> ShowS
show :: RLCullMode -> String
$cshow :: RLCullMode -> String
showsPrec :: Int -> RLCullMode -> ShowS
$cshowsPrec :: Int -> RLCullMode -> ShowS
Show, Int -> RLCullMode
RLCullMode -> Int
RLCullMode -> [RLCullMode]
RLCullMode -> RLCullMode
RLCullMode -> RLCullMode -> [RLCullMode]
RLCullMode -> RLCullMode -> RLCullMode -> [RLCullMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RLCullMode -> RLCullMode -> RLCullMode -> [RLCullMode]
$cenumFromThenTo :: RLCullMode -> RLCullMode -> RLCullMode -> [RLCullMode]
enumFromTo :: RLCullMode -> RLCullMode -> [RLCullMode]
$cenumFromTo :: RLCullMode -> RLCullMode -> [RLCullMode]
enumFromThen :: RLCullMode -> RLCullMode -> [RLCullMode]
$cenumFromThen :: RLCullMode -> RLCullMode -> [RLCullMode]
enumFrom :: RLCullMode -> [RLCullMode]
$cenumFrom :: RLCullMode -> [RLCullMode]
fromEnum :: RLCullMode -> Int
$cfromEnum :: RLCullMode -> Int
toEnum :: Int -> RLCullMode
$ctoEnum :: Int -> RLCullMode
pred :: RLCullMode -> RLCullMode
$cpred :: RLCullMode -> RLCullMode
succ :: RLCullMode -> RLCullMode
$csucc :: RLCullMode -> RLCullMode
Enum)

instance Storable RLCullMode where
  sizeOf :: RLCullMode -> Int
sizeOf RLCullMode
_ = Int
4
  alignment :: RLCullMode -> Int
alignment RLCullMode
_ = Int
4
  peek :: Ptr RLCullMode -> IO RLCullMode
peek Ptr RLCullMode
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLCullMode
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLCullMode -> RLCullMode -> IO ()
poke Ptr RLCullMode
ptr RLCullMode
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLCullMode
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLCullMode
v) :: CInt)

-- | Matrix modes (equivalent to OpenGL)

data RLMatrixMode
  -- | GL_MODELVIEW

  = RLModelView
  -- | GL_PROJECTION

  | RLProjection
  -- | GL_TEXTURE

  | RLTexture
  deriving (RLMatrixMode -> RLMatrixMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLMatrixMode -> RLMatrixMode -> Bool
$c/= :: RLMatrixMode -> RLMatrixMode -> Bool
== :: RLMatrixMode -> RLMatrixMode -> Bool
$c== :: RLMatrixMode -> RLMatrixMode -> Bool
Eq, Int -> RLMatrixMode -> ShowS
[RLMatrixMode] -> ShowS
RLMatrixMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLMatrixMode] -> ShowS
$cshowList :: [RLMatrixMode] -> ShowS
show :: RLMatrixMode -> String
$cshow :: RLMatrixMode -> String
showsPrec :: Int -> RLMatrixMode -> ShowS
$cshowsPrec :: Int -> RLMatrixMode -> ShowS
Show)

instance Enum RLMatrixMode where
  fromEnum :: RLMatrixMode -> Int
fromEnum RLMatrixMode
n = case RLMatrixMode
n of
    RLMatrixMode
RLModelView -> Int
0x1700
    RLMatrixMode
RLProjection -> Int
0x1701
    RLMatrixMode
RLTexture -> Int
0x1702

  toEnum :: Int -> RLMatrixMode
toEnum Int
n = case Int
n of
    Int
0x1700 -> RLMatrixMode
RLModelView
    Int
0x1701 -> RLMatrixMode
RLProjection
    Int
0x1702 -> RLMatrixMode
RLTexture
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLMatrixMode.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLMatrixMode where
  sizeOf :: RLMatrixMode -> Int
sizeOf RLMatrixMode
_ = Int
4
  alignment :: RLMatrixMode -> Int
alignment RLMatrixMode
_ = Int
4
  peek :: Ptr RLMatrixMode -> IO RLMatrixMode
peek Ptr RLMatrixMode
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLMatrixMode
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLMatrixMode -> RLMatrixMode -> IO ()
poke Ptr RLMatrixMode
ptr RLMatrixMode
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLMatrixMode
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLMatrixMode
v) :: CInt)

-- | Primitive assembly draw modes

data RLDrawMode
  -- | GL_LINES

  = RLLines
  -- | GL_TRIANGLES

  | RLTriangles
  -- | GL_QUADS

  | RLQuads
  deriving (RLDrawMode -> RLDrawMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLDrawMode -> RLDrawMode -> Bool
$c/= :: RLDrawMode -> RLDrawMode -> Bool
== :: RLDrawMode -> RLDrawMode -> Bool
$c== :: RLDrawMode -> RLDrawMode -> Bool
Eq, Int -> RLDrawMode -> ShowS
[RLDrawMode] -> ShowS
RLDrawMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLDrawMode] -> ShowS
$cshowList :: [RLDrawMode] -> ShowS
show :: RLDrawMode -> String
$cshow :: RLDrawMode -> String
showsPrec :: Int -> RLDrawMode -> ShowS
$cshowsPrec :: Int -> RLDrawMode -> ShowS
Show)

instance Enum RLDrawMode where
  fromEnum :: RLDrawMode -> Int
fromEnum RLDrawMode
n = case RLDrawMode
n of
    RLDrawMode
RLLines -> Int
0x0001
    RLDrawMode
RLTriangles -> Int
0x0004
    RLDrawMode
RLQuads -> Int
0x0007

  toEnum :: Int -> RLDrawMode
toEnum Int
n = case Int
n of
    Int
0x0001 -> RLDrawMode
RLLines
    Int
0x0004 -> RLDrawMode
RLTriangles
    Int
0x0007 -> RLDrawMode
RLQuads
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLDrawMode.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLDrawMode where
  sizeOf :: RLDrawMode -> Int
sizeOf RLDrawMode
_ = Int
4
  alignment :: RLDrawMode -> Int
alignment RLDrawMode
_ = Int
4
  peek :: Ptr RLDrawMode -> IO RLDrawMode
peek Ptr RLDrawMode
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLDrawMode
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLDrawMode -> RLDrawMode -> IO ()
poke Ptr RLDrawMode
ptr RLDrawMode
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLDrawMode
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLDrawMode
v) :: CInt)

-- | Texture parameters (equivalent to OpenGL defines)

data RLTextureParam
  -- | GL_TEXTURE_WRAP_S

  = RLTextureParamWrapS
  -- | GL_TEXTURE_WRAP_T

  | RLTextureParamWrapT
  -- | GL_TEXTURE_MAG_FILTER

  | RLTextureParamMagFilter
  -- | GL_TEXTURE_MIN_FILTER

  | RLTextureParamMinFilter
  -- | GL_NEAREST

  | RLTextureParamFilterNearest
  -- | GL_LINEAR

  | RLTextureParamFilterLinear
  -- | GL_NEAREST_MIPMAP_NEAREST

  | RLTextureParamFilterMipNearest
  -- | GL_NEAREST_MIPMAP_LINEAR

  | RLTextureParamFilterNearestMipLinear
  -- | GL_LINEAR_MIPMAP_NEAREST

  | RLTextureParamFilterLinearMipNearest
  -- | GL_LINEAR_MIPMAP_LINEAR

  | RLTextureParamFilterMipLinear
  -- | Anisotropic filter (custom identifier)

  | RLTextureParamFilterAnisotropic
  -- | Texture mipmap bias, percentage ratio (custom identifier)

  | RLTextureParamMipmapBiasRatio
  deriving (RLTextureParam -> RLTextureParam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLTextureParam -> RLTextureParam -> Bool
$c/= :: RLTextureParam -> RLTextureParam -> Bool
== :: RLTextureParam -> RLTextureParam -> Bool
$c== :: RLTextureParam -> RLTextureParam -> Bool
Eq, Int -> RLTextureParam -> ShowS
[RLTextureParam] -> ShowS
RLTextureParam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLTextureParam] -> ShowS
$cshowList :: [RLTextureParam] -> ShowS
show :: RLTextureParam -> String
$cshow :: RLTextureParam -> String
showsPrec :: Int -> RLTextureParam -> ShowS
$cshowsPrec :: Int -> RLTextureParam -> ShowS
Show)

instance Enum RLTextureParam where
  fromEnum :: RLTextureParam -> Int
fromEnum RLTextureParam
n = case RLTextureParam
n of
    RLTextureParam
RLTextureParamWrapS -> Int
0x2802
    RLTextureParam
RLTextureParamWrapT -> Int
0x2803
    RLTextureParam
RLTextureParamMagFilter -> Int
0x2800
    RLTextureParam
RLTextureParamMinFilter -> Int
0x2801
    RLTextureParam
RLTextureParamFilterNearest -> Int
0x2600
    RLTextureParam
RLTextureParamFilterLinear -> Int
0x2601
    RLTextureParam
RLTextureParamFilterMipNearest -> Int
0x2700
    RLTextureParam
RLTextureParamFilterNearestMipLinear -> Int
0x2702
    RLTextureParam
RLTextureParamFilterLinearMipNearest -> Int
0x2701
    RLTextureParam
RLTextureParamFilterMipLinear -> Int
0x2703
    RLTextureParam
RLTextureParamFilterAnisotropic -> Int
0x3000
    RLTextureParam
RLTextureParamMipmapBiasRatio -> Int
0x4000

  toEnum :: Int -> RLTextureParam
toEnum Int
n = case Int
n of
    Int
0x2802 -> RLTextureParam
RLTextureParamWrapS
    Int
0x2803 -> RLTextureParam
RLTextureParamWrapT
    Int
0x2800 -> RLTextureParam
RLTextureParamMagFilter
    Int
0x2801 -> RLTextureParam
RLTextureParamMinFilter
    Int
0x2600 -> RLTextureParam
RLTextureParamFilterNearest
    Int
0x2601 -> RLTextureParam
RLTextureParamFilterLinear
    Int
0x2700 -> RLTextureParam
RLTextureParamFilterMipNearest
    Int
0x2702 -> RLTextureParam
RLTextureParamFilterNearestMipLinear
    Int
0x2701 -> RLTextureParam
RLTextureParamFilterLinearMipNearest
    Int
0x2703 -> RLTextureParam
RLTextureParamFilterMipLinear
    Int
0x3000 -> RLTextureParam
RLTextureParamFilterAnisotropic
    Int
0x4000 -> RLTextureParam
RLTextureParamMipmapBiasRatio
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLTextureParam.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLTextureParam where
  sizeOf :: RLTextureParam -> Int
sizeOf RLTextureParam
_ = Int
4
  alignment :: RLTextureParam -> Int
alignment RLTextureParam
_ = Int
4
  peek :: Ptr RLTextureParam -> IO RLTextureParam
peek Ptr RLTextureParam
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTextureParam
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLTextureParam -> RLTextureParam -> IO ()
poke Ptr RLTextureParam
ptr RLTextureParam
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLTextureParam
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLTextureParam
v) :: CInt)

-- | OpenGL shader type

data RLShaderType
  -- | GL_FRAGMENT_SHADER

  = RLFragmentShader
  -- | GL_VERTEX_SHADER

  | RLVertexShader
  -- | GL_COMPUTE_SHADER

  | RLComputeShader
  deriving (RLShaderType -> RLShaderType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLShaderType -> RLShaderType -> Bool
$c/= :: RLShaderType -> RLShaderType -> Bool
== :: RLShaderType -> RLShaderType -> Bool
$c== :: RLShaderType -> RLShaderType -> Bool
Eq, Int -> RLShaderType -> ShowS
[RLShaderType] -> ShowS
RLShaderType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLShaderType] -> ShowS
$cshowList :: [RLShaderType] -> ShowS
show :: RLShaderType -> String
$cshow :: RLShaderType -> String
showsPrec :: Int -> RLShaderType -> ShowS
$cshowsPrec :: Int -> RLShaderType -> ShowS
Show)

instance Enum RLShaderType where
  fromEnum :: RLShaderType -> Int
fromEnum RLShaderType
n = case RLShaderType
n of
    RLShaderType
RLFragmentShader -> Int
0x8B30
    RLShaderType
RLVertexShader -> Int
0x8B31
    RLShaderType
RLComputeShader -> Int
0x91B9

  toEnum :: Int -> RLShaderType
toEnum Int
n = case Int
n of
    Int
0x8B30 -> RLShaderType
RLFragmentShader
    Int
0x8B31 -> RLShaderType
RLVertexShader
    Int
0x91B9 -> RLShaderType
RLComputeShader
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLShaderType.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLShaderType where
  sizeOf :: RLShaderType -> Int
sizeOf RLShaderType
_ = Int
4
  alignment :: RLShaderType -> Int
alignment RLShaderType
_ = Int
4
  peek :: Ptr RLShaderType -> IO RLShaderType
peek Ptr RLShaderType
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderType
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLShaderType -> RLShaderType -> IO ()
poke Ptr RLShaderType
ptr RLShaderType
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLShaderType
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLShaderType
v) :: CInt)

-- | GL buffer usage hint

data RLBufferHint
  -- | GL_STREAM_DRAW

  = RLBufferHintStreamDraw
  -- | GL_STREAM_READ

  | RLBufferHintStreamRead
  -- | GL_STREAM_COPY

  | RLBufferHintStreamCopy
  -- | GL_STATIC_DRAW

  | RLBufferHintStaticDraw
  -- | GL_STATIC_READ

  | RLBufferHintStaticRead
  -- | GL_STATIC_COPY

  | RLBufferHintStaticCopy
  -- | GL_DYNAMIC_DRAW

  | RLBufferHintDynamicDraw
  -- | GL_DYNAMIC_READ

  | RLBufferHintDynamicRead
  -- | GL_DYNAMIC_COPY

  | RLBufferHintDynamicCopy
  deriving (RLBufferHint -> RLBufferHint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLBufferHint -> RLBufferHint -> Bool
$c/= :: RLBufferHint -> RLBufferHint -> Bool
== :: RLBufferHint -> RLBufferHint -> Bool
$c== :: RLBufferHint -> RLBufferHint -> Bool
Eq, Int -> RLBufferHint -> ShowS
[RLBufferHint] -> ShowS
RLBufferHint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLBufferHint] -> ShowS
$cshowList :: [RLBufferHint] -> ShowS
show :: RLBufferHint -> String
$cshow :: RLBufferHint -> String
showsPrec :: Int -> RLBufferHint -> ShowS
$cshowsPrec :: Int -> RLBufferHint -> ShowS
Show)

instance Enum RLBufferHint where
  fromEnum :: RLBufferHint -> Int
fromEnum RLBufferHint
n = case RLBufferHint
n of
    RLBufferHint
RLBufferHintStreamDraw -> Int
0x88E0
    RLBufferHint
RLBufferHintStreamRead -> Int
0x88E1
    RLBufferHint
RLBufferHintStreamCopy -> Int
0x88E2
    RLBufferHint
RLBufferHintStaticDraw -> Int
0x88E4
    RLBufferHint
RLBufferHintStaticRead -> Int
0x88E5
    RLBufferHint
RLBufferHintStaticCopy -> Int
0x88E6
    RLBufferHint
RLBufferHintDynamicDraw -> Int
0x88E8
    RLBufferHint
RLBufferHintDynamicRead -> Int
0x88E9
    RLBufferHint
RLBufferHintDynamicCopy -> Int
0x88EA

  toEnum :: Int -> RLBufferHint
toEnum Int
n = case Int
n of
    Int
0x88E0 -> RLBufferHint
RLBufferHintStreamDraw
    Int
0x88E1 -> RLBufferHint
RLBufferHintStreamRead
    Int
0x88E2 -> RLBufferHint
RLBufferHintStreamCopy
    Int
0x88E4 -> RLBufferHint
RLBufferHintStaticDraw
    Int
0x88E5 -> RLBufferHint
RLBufferHintStaticRead
    Int
0x88E6 -> RLBufferHint
RLBufferHintStaticCopy
    Int
0x88E8 -> RLBufferHint
RLBufferHintDynamicDraw
    Int
0x88E9 -> RLBufferHint
RLBufferHintDynamicRead
    Int
0x88EA -> RLBufferHint
RLBufferHintDynamicCopy
    Int
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"(RLBufferHint.toEnum) Invalid value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

instance Storable RLBufferHint where
  sizeOf :: RLBufferHint -> Int
sizeOf RLBufferHint
_ = Int
4
  alignment :: RLBufferHint -> Int
alignment RLBufferHint
_ = Int
4
  peek :: Ptr RLBufferHint -> IO RLBufferHint
peek Ptr RLBufferHint
ptr = do
    CInt
val <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr RLBufferHint
ptr)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum (CInt
val :: CInt)
  poke :: Ptr RLBufferHint -> RLBufferHint -> IO ()
poke Ptr RLBufferHint
ptr RLBufferHint
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr RLBufferHint
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum RLBufferHint
v) :: CInt)

------------------------------------------------

-- Raylib structures ---------------------------

------------------------------------------------


---- raylib.h


data Vector2 = Vector2
  { Vector2 -> Float
vector2'x :: Float,
    Vector2 -> Float
vector2'y :: Float
  }
  deriving (Vector2 -> Vector2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector2 -> Vector2 -> Bool
$c/= :: Vector2 -> Vector2 -> Bool
== :: Vector2 -> Vector2 -> Bool
$c== :: Vector2 -> Vector2 -> Bool
Eq, Int -> Vector2 -> ShowS
[Vector2] -> ShowS
Vector2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector2] -> ShowS
$cshowList :: [Vector2] -> ShowS
show :: Vector2 -> String
$cshow :: Vector2 -> String
showsPrec :: Int -> Vector2 -> ShowS
$cshowsPrec :: Int -> Vector2 -> ShowS
Show, Vector2 -> Ptr Vector2 -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Vector2 -> Ptr Vector2 -> IO ()
$crlFree :: Vector2 -> Ptr Vector2 -> IO ()
rlFreeDependents :: Vector2 -> Ptr Vector2 -> IO ()
$crlFreeDependents :: Vector2 -> Ptr Vector2 -> IO ()
Freeable)

instance Storable Vector2 where
  sizeOf :: Vector2 -> Int
sizeOf Vector2
_ = Int
8
  alignment :: Vector2 -> Int
alignment Vector2
_ = Int
4
  peek :: Ptr Vector2 -> IO Vector2
peek Ptr Vector2
_p = do
    Float
x <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector2
_p Int
0 :: IO CFloat)
    Float
y <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector2
_p Int
4 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> Float -> Vector2
Vector2 Float
x Float
y
  poke :: Ptr Vector2 -> Vector2 -> IO ()
poke Ptr Vector2
_p (Vector2 Float
x Float
y) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector2
_p Int
0 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector2
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Vector3 = Vector3
  { Vector3 -> Float
vector3'x :: Float,
    Vector3 -> Float
vector3'y :: Float,
    Vector3 -> Float
vector3'z :: Float
  }
  deriving (Vector3 -> Vector3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector3 -> Vector3 -> Bool
$c/= :: Vector3 -> Vector3 -> Bool
== :: Vector3 -> Vector3 -> Bool
$c== :: Vector3 -> Vector3 -> Bool
Eq, Int -> Vector3 -> ShowS
[Vector3] -> ShowS
Vector3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector3] -> ShowS
$cshowList :: [Vector3] -> ShowS
show :: Vector3 -> String
$cshow :: Vector3 -> String
showsPrec :: Int -> Vector3 -> ShowS
$cshowsPrec :: Int -> Vector3 -> ShowS
Show, Vector3 -> Ptr Vector3 -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Vector3 -> Ptr Vector3 -> IO ()
$crlFree :: Vector3 -> Ptr Vector3 -> IO ()
rlFreeDependents :: Vector3 -> Ptr Vector3 -> IO ()
$crlFreeDependents :: Vector3 -> Ptr Vector3 -> IO ()
Freeable)

instance Storable Vector3 where
  sizeOf :: Vector3 -> Int
sizeOf Vector3
_ = Int
12
  alignment :: Vector3 -> Int
alignment Vector3
_ = Int
4
  peek :: Ptr Vector3 -> IO Vector3
peek Ptr Vector3
_p = do
    Float
x <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector3
_p Int
0 :: IO CFloat)
    Float
y <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector3
_p Int
4 :: IO CFloat)
    Float
z <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector3
_p Int
8 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Vector3
Vector3 Float
x Float
y Float
z
  poke :: Ptr Vector3 -> Vector3 -> IO ()
poke Ptr Vector3
_p (Vector3 Float
x Float
y Float
z) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector3
_p Int
0 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector3
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector3
_p Int
8 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Vector4 = Vector4
  { Vector4 -> Float
vector4'x :: Float,
    Vector4 -> Float
vector4'y :: Float,
    Vector4 -> Float
vector4'z :: Float,
    Vector4 -> Float
vector4'w :: Float
  }
  deriving (Vector4 -> Vector4 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector4 -> Vector4 -> Bool
$c/= :: Vector4 -> Vector4 -> Bool
== :: Vector4 -> Vector4 -> Bool
$c== :: Vector4 -> Vector4 -> Bool
Eq, Int -> Vector4 -> ShowS
[Vector4] -> ShowS
Vector4 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector4] -> ShowS
$cshowList :: [Vector4] -> ShowS
show :: Vector4 -> String
$cshow :: Vector4 -> String
showsPrec :: Int -> Vector4 -> ShowS
$cshowsPrec :: Int -> Vector4 -> ShowS
Show, Vector4 -> Ptr Vector4 -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Vector4 -> Ptr Vector4 -> IO ()
$crlFree :: Vector4 -> Ptr Vector4 -> IO ()
rlFreeDependents :: Vector4 -> Ptr Vector4 -> IO ()
$crlFreeDependents :: Vector4 -> Ptr Vector4 -> IO ()
Freeable)

instance Storable Vector4 where
  sizeOf :: Vector4 -> Int
sizeOf Vector4
_ = Int
16
  alignment :: Vector4 -> Int
alignment Vector4
_ = Int
4
  peek :: Ptr Vector4 -> IO Vector4
peek Ptr Vector4
_p = do
    Float
x <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector4
_p Int
0 :: IO CFloat)
    Float
y <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector4
_p Int
4 :: IO CFloat)
    Float
z <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector4
_p Int
8 :: IO CFloat)
    Float
w <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vector4
_p Int
12 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vector4
Vector4 Float
x Float
y Float
z Float
w
  poke :: Ptr Vector4 -> Vector4 -> IO ()
poke Ptr Vector4
_p (Vector4 Float
x Float
y Float
z Float
w) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector4
_p Int
0 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector4
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector4
_p Int
8 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vector4
_p Int
12 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
w :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

type Quaternion = Vector4

data Matrix = Matrix
  { Matrix -> Float
matrix'm0 :: Float,
    Matrix -> Float
matrix'm4 :: Float,
    Matrix -> Float
matrix'm8 :: Float,
    Matrix -> Float
matrix'm12 :: Float,
    Matrix -> Float
matrix'm1 :: Float,
    Matrix -> Float
matrix'm5 :: Float,
    Matrix -> Float
matrix'm9 :: Float,
    Matrix -> Float
matrix'm13 :: Float,
    Matrix -> Float
matrix'm2 :: Float,
    Matrix -> Float
matrix'm6 :: Float,
    Matrix -> Float
matrix'm10 :: Float,
    Matrix -> Float
matrix'm14 :: Float,
    Matrix -> Float
matrix'm3 :: Float,
    Matrix -> Float
matrix'm7 :: Float,
    Matrix -> Float
matrix'm11 :: Float,
    Matrix -> Float
matrix'm15 :: Float
  }
  deriving (Matrix -> Matrix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matrix -> Matrix -> Bool
$c/= :: Matrix -> Matrix -> Bool
== :: Matrix -> Matrix -> Bool
$c== :: Matrix -> Matrix -> Bool
Eq, Int -> Matrix -> ShowS
[Matrix] -> ShowS
Matrix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Matrix] -> ShowS
$cshowList :: [Matrix] -> ShowS
show :: Matrix -> String
$cshow :: Matrix -> String
showsPrec :: Int -> Matrix -> ShowS
$cshowsPrec :: Int -> Matrix -> ShowS
Show, Matrix -> Ptr Matrix -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Matrix -> Ptr Matrix -> IO ()
$crlFree :: Matrix -> Ptr Matrix -> IO ()
rlFreeDependents :: Matrix -> Ptr Matrix -> IO ()
$crlFreeDependents :: Matrix -> Ptr Matrix -> IO ()
Freeable)

instance Storable Matrix where
  sizeOf :: Matrix -> Int
sizeOf Matrix
_ = Int
64
  alignment :: Matrix -> Int
alignment Matrix
_ = Int
4
  peek :: Ptr Matrix -> IO Matrix
peek Ptr Matrix
_p = do
    Float
m0 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
0 :: IO CFloat)
    Float
m4 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
4 :: IO CFloat)
    Float
m8 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
8 :: IO CFloat)
    Float
m12 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
12 :: IO CFloat)
    Float
m1 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
16 :: IO CFloat)
    Float
m5 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
20 :: IO CFloat)
    Float
m9 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
24 :: IO CFloat)
    Float
m13 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
28 :: IO CFloat)
    Float
m2 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
32 :: IO CFloat)
    Float
m6 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
36 :: IO CFloat)
    Float
m10 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
40 :: IO CFloat)
    Float
m14 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
44 :: IO CFloat)
    Float
m3 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
48 :: IO CFloat)
    Float
m7 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
52 :: IO CFloat)
    Float
m11 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
56 :: IO CFloat)
    Float
m15 <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Matrix
_p Int
60 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Matrix
Matrix Float
m0 Float
m4 Float
m8 Float
m12 Float
m1 Float
m5 Float
m9 Float
m13 Float
m2 Float
m6 Float
m10 Float
m14 Float
m3 Float
m7 Float
m11 Float
m15
  poke :: Ptr Matrix -> Matrix -> IO ()
poke Ptr Matrix
_p (Matrix Float
m0 Float
m4 Float
m8 Float
m12 Float
m1 Float
m5 Float
m9 Float
m13 Float
m2 Float
m6 Float
m10 Float
m14 Float
m3 Float
m7 Float
m11 Float
m15) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
0 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m0 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m4 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
8 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m8 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
12 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m12 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
16 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m1 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
20 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m5 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
24 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m9 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
28 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m13 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
32 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m2 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
36 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m6 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
40 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m10 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
44 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m14 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
48 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m3 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
52 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m7 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
56 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m11 :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Matrix
_p Int
60 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
m15 :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

vectorToColor :: Vector4 -> Color
vectorToColor :: Vector4 -> Color
vectorToColor (Vector4 Float
x Float
y Float
z Float
w) = Word8 -> Word8 -> Word8 -> Word8 -> Color
Color (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Float
x forall a. Num a => a -> a -> a
* Float
255) (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Float
y forall a. Num a => a -> a -> a
* Float
255) (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Float
z forall a. Num a => a -> a -> a
* Float
255) (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Float
w forall a. Num a => a -> a -> a
* Float
255)

data Color = Color
  { Color -> Word8
color'r :: Word8,
    Color -> Word8
color'g :: Word8,
    Color -> Word8
color'b :: Word8,
    Color -> Word8
color'a :: Word8
  }
  deriving (Color -> Color -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Ptr Color -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Color -> Ptr Color -> IO ()
$crlFree :: Color -> Ptr Color -> IO ()
rlFreeDependents :: Color -> Ptr Color -> IO ()
$crlFreeDependents :: Color -> Ptr Color -> IO ()
Freeable)

instance Storable Color where
  sizeOf :: Color -> Int
sizeOf Color
_ = Int
4
  alignment :: Color -> Int
alignment Color
_ = Int
1
  peek :: Ptr Color -> IO Color
peek Ptr Color
_p = do
    Word8
r <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Color
_p Int
0 :: IO CUChar)
    Word8
g <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Color
_p Int
1 :: IO CUChar)
    Word8
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Color
_p Int
2 :: IO CUChar)
    Word8
a <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Color
_p Int
3 :: IO CUChar)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> Color
Color Word8
r Word8
g Word8
b Word8
a
  poke :: Ptr Color -> Color -> IO ()
poke Ptr Color
_p (Color Word8
r Word8
g Word8
b Word8
a) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Color
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r :: CUChar)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Color
_p Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g :: CUChar)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Color
_p Int
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b :: CUChar)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Color
_p Int
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a :: CUChar)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Rectangle = Rectangle
  { Rectangle -> Float
rectangle'x :: Float,
    Rectangle -> Float
rectangle'y :: Float,
    Rectangle -> Float
rectangle'width :: Float,
    Rectangle -> Float
rectangle'height :: Float
  }
  deriving (Rectangle -> Rectangle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rectangle -> Rectangle -> Bool
$c/= :: Rectangle -> Rectangle -> Bool
== :: Rectangle -> Rectangle -> Bool
$c== :: Rectangle -> Rectangle -> Bool
Eq, Int -> Rectangle -> ShowS
[Rectangle] -> ShowS
Rectangle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rectangle] -> ShowS
$cshowList :: [Rectangle] -> ShowS
show :: Rectangle -> String
$cshow :: Rectangle -> String
showsPrec :: Int -> Rectangle -> ShowS
$cshowsPrec :: Int -> Rectangle -> ShowS
Show, Rectangle -> Ptr Rectangle -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Rectangle -> Ptr Rectangle -> IO ()
$crlFree :: Rectangle -> Ptr Rectangle -> IO ()
rlFreeDependents :: Rectangle -> Ptr Rectangle -> IO ()
$crlFreeDependents :: Rectangle -> Ptr Rectangle -> IO ()
Freeable)

instance Storable Rectangle where
  sizeOf :: Rectangle -> Int
sizeOf Rectangle
_ = Int
16
  alignment :: Rectangle -> Int
alignment Rectangle
_ = Int
4
  peek :: Ptr Rectangle -> IO Rectangle
peek Ptr Rectangle
_p = do
    Float
x <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Rectangle
_p Int
0 :: IO CFloat)
    Float
y <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Rectangle
_p Int
4 :: IO CFloat)
    Float
width <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Rectangle
_p Int
8 :: IO CFloat)
    Float
height <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Rectangle
_p Int
12 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Rectangle
Rectangle Float
x Float
y Float
width Float
height
  poke :: Ptr Rectangle -> Rectangle -> IO ()
poke Ptr Rectangle
_p (Rectangle Float
x Float
y Float
width Float
height) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Rectangle
_p Int
0 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Rectangle
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Rectangle
_p Int
8 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Rectangle
_p Int
12 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Image = Image
  { Image -> [Word8]
image'data :: [Word8],
    Image -> Int
image'width :: Int,
    Image -> Int
image'height :: Int,
    Image -> Int
image'mipmaps :: Int,
    Image -> PixelFormat
image'format :: PixelFormat
  }
  deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show)

instance Storable Image where
  sizeOf :: Image -> Int
sizeOf Image
_ = Int
24
  alignment :: Image -> Int
alignment Image
_ = Int
4
  peek :: Ptr Image -> IO Image
peek Ptr Image
_p = do
    Int
width <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
_p Int
8 :: IO CInt)
    Int
height <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
_p Int
12 :: IO CInt)
    Int
mipmaps <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
_p Int
16 :: IO CInt)
    PixelFormat
format <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
_p Int
20
    Ptr CUChar
ptr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
_p Int
0 :: IO (Ptr CUChar))
    [CUChar]
arr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int -> Int -> Int -> Int
getPixelDataSize Int
width Int
height (forall a. Enum a => a -> Int
fromEnum PixelFormat
format)) Ptr CUChar
ptr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
Image (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
arr) Int
width Int
height Int
mipmaps PixelFormat
format
  poke :: Ptr Image -> Image -> IO ()
poke Ptr Image
_p (Image [Word8]
arr Int
width Int
height Int
mipmaps PixelFormat
format) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Image
_p Int
0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8]
arr :: [CUChar])
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Image
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Image
_p Int
12 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Image
_p Int
16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mipmaps :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Image
_p Int
20 PixelFormat
format
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Image where
  rlFreeDependents :: Image -> Ptr Image -> IO ()
rlFreeDependents Image
_ Ptr Image
ptr = do
    Ptr CUChar
dataPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Image
ptr Int
0 :: IO (Ptr CUChar))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
dataPtr

data Texture = Texture
  { Texture -> Integer
texture'id :: Integer,
    Texture -> Int
texture'width :: Int,
    Texture -> Int
texture'height :: Int,
    Texture -> Int
texture'mipmaps :: Int,
    Texture -> PixelFormat
texture'format :: PixelFormat
  }
  deriving (Texture -> Texture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c== :: Texture -> Texture -> Bool
Eq, Int -> Texture -> ShowS
[Texture] -> ShowS
Texture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Texture] -> ShowS
$cshowList :: [Texture] -> ShowS
show :: Texture -> String
$cshow :: Texture -> String
showsPrec :: Int -> Texture -> ShowS
$cshowsPrec :: Int -> Texture -> ShowS
Show, Texture -> Ptr Texture -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Texture -> Ptr Texture -> IO ()
$crlFree :: Texture -> Ptr Texture -> IO ()
rlFreeDependents :: Texture -> Ptr Texture -> IO ()
$crlFreeDependents :: Texture -> Ptr Texture -> IO ()
Freeable)

instance Storable Texture where
  sizeOf :: Texture -> Int
sizeOf Texture
_ = Int
20
  alignment :: Texture -> Int
alignment Texture
_ = Int
4
  peek :: Ptr Texture -> IO Texture
peek Ptr Texture
_p = do
    Integer
tId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Texture
_p Int
0 :: IO CUInt)
    Int
width <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Texture
_p Int
4 :: IO CInt)
    Int
height <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Texture
_p Int
8 :: IO CInt)
    Int
mipmaps <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Texture
_p Int
12 :: IO CInt)
    PixelFormat
format <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Texture
_p Int
16
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Int -> PixelFormat -> Texture
Texture Integer
tId Int
width Int
height Int
mipmaps PixelFormat
format
  poke :: Ptr Texture -> Texture -> IO ()
poke Ptr Texture
_p (Texture Integer
tId Int
width Int
height Int
mipmaps PixelFormat
format) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Texture
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tId :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Texture
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Texture
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Texture
_p Int
12 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mipmaps :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Texture
_p Int
16 PixelFormat
format
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

type Texture2D = Texture

type TextureCubemap = Texture

data RenderTexture = RenderTexture
  { RenderTexture -> Integer
renderTexture'id :: Integer,
    RenderTexture -> Texture
renderTexture'texture :: Texture,
    RenderTexture -> Texture
renderTexture'depth :: Texture
  }
  deriving (RenderTexture -> RenderTexture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderTexture -> RenderTexture -> Bool
$c/= :: RenderTexture -> RenderTexture -> Bool
== :: RenderTexture -> RenderTexture -> Bool
$c== :: RenderTexture -> RenderTexture -> Bool
Eq, Int -> RenderTexture -> ShowS
[RenderTexture] -> ShowS
RenderTexture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderTexture] -> ShowS
$cshowList :: [RenderTexture] -> ShowS
show :: RenderTexture -> String
$cshow :: RenderTexture -> String
showsPrec :: Int -> RenderTexture -> ShowS
$cshowsPrec :: Int -> RenderTexture -> ShowS
Show, RenderTexture -> Ptr RenderTexture -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: RenderTexture -> Ptr RenderTexture -> IO ()
$crlFree :: RenderTexture -> Ptr RenderTexture -> IO ()
rlFreeDependents :: RenderTexture -> Ptr RenderTexture -> IO ()
$crlFreeDependents :: RenderTexture -> Ptr RenderTexture -> IO ()
Freeable)

instance Storable RenderTexture where
  sizeOf :: RenderTexture -> Int
sizeOf RenderTexture
_ = Int
44
  alignment :: RenderTexture -> Int
alignment RenderTexture
_ = Int
4
  peek :: Ptr RenderTexture -> IO RenderTexture
peek Ptr RenderTexture
_p = do
    Integer
rtId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RenderTexture
_p Int
0 :: IO CUInt)
    Texture
texture <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RenderTexture
_p Int
4
    Texture
depth <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RenderTexture
_p Int
24
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Texture -> Texture -> RenderTexture
RenderTexture Integer
rtId Texture
texture Texture
depth
  poke :: Ptr RenderTexture -> RenderTexture -> IO ()
poke Ptr RenderTexture
_p (RenderTexture Integer
rtId Texture
texture Texture
depth) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RenderTexture
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
rtId :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RenderTexture
_p Int
4 Texture
texture
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RenderTexture
_p Int
24 Texture
depth
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

type RenderTexture2D = RenderTexture

data NPatchInfo = NPatchInfo
  { NPatchInfo -> Rectangle
nPatchInfo'source :: Rectangle,
    NPatchInfo -> Int
nPatchInfo'left :: Int,
    NPatchInfo -> Int
nPatchInfo'top :: Int,
    NPatchInfo -> Int
nPatchInfo'right :: Int,
    NPatchInfo -> Int
nPatchInfo'bottom :: Int,
    NPatchInfo -> NPatchLayout
nPatchInfo'layout :: NPatchLayout
  }
  deriving (NPatchInfo -> NPatchInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NPatchInfo -> NPatchInfo -> Bool
$c/= :: NPatchInfo -> NPatchInfo -> Bool
== :: NPatchInfo -> NPatchInfo -> Bool
$c== :: NPatchInfo -> NPatchInfo -> Bool
Eq, Int -> NPatchInfo -> ShowS
[NPatchInfo] -> ShowS
NPatchInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NPatchInfo] -> ShowS
$cshowList :: [NPatchInfo] -> ShowS
show :: NPatchInfo -> String
$cshow :: NPatchInfo -> String
showsPrec :: Int -> NPatchInfo -> ShowS
$cshowsPrec :: Int -> NPatchInfo -> ShowS
Show, NPatchInfo -> Ptr NPatchInfo -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: NPatchInfo -> Ptr NPatchInfo -> IO ()
$crlFree :: NPatchInfo -> Ptr NPatchInfo -> IO ()
rlFreeDependents :: NPatchInfo -> Ptr NPatchInfo -> IO ()
$crlFreeDependents :: NPatchInfo -> Ptr NPatchInfo -> IO ()
Freeable)

instance Storable NPatchInfo where
  sizeOf :: NPatchInfo -> Int
sizeOf NPatchInfo
_ = Int
36
  alignment :: NPatchInfo -> Int
alignment NPatchInfo
_ = Int
4
  peek :: Ptr NPatchInfo -> IO NPatchInfo
peek Ptr NPatchInfo
_p = do
    Rectangle
source <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
0
    Int
left <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
16 :: IO CInt)
    Int
top <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
20 :: IO CInt)
    Int
right <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
24 :: IO CInt)
    Int
bottom <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
28 :: IO CInt)
    NPatchLayout
layout <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NPatchInfo
_p Int
32
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
NPatchInfo Rectangle
source Int
left Int
right Int
top Int
bottom NPatchLayout
layout
  poke :: Ptr NPatchInfo -> NPatchInfo -> IO ()
poke Ptr NPatchInfo
_p (NPatchInfo Rectangle
source Int
left Int
right Int
top Int
bottom NPatchLayout
layout) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
0 Rectangle
source
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
left :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
20 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
right :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
24 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
top :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
28 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bottom :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr NPatchInfo
_p Int
32 NPatchLayout
layout
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data GlyphInfo = GlyphInfo
  { GlyphInfo -> Int
glyphInfo'value :: Int,
    GlyphInfo -> Int
glyphInfo'offsetX :: Int,
    GlyphInfo -> Int
glyphInfo'offsetY :: Int,
    GlyphInfo -> Int
glyphInfo'advanceX :: Int,
    GlyphInfo -> Image
glyphInfo'image :: Image
  }
  deriving (GlyphInfo -> GlyphInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphInfo -> GlyphInfo -> Bool
$c/= :: GlyphInfo -> GlyphInfo -> Bool
== :: GlyphInfo -> GlyphInfo -> Bool
$c== :: GlyphInfo -> GlyphInfo -> Bool
Eq, Int -> GlyphInfo -> ShowS
[GlyphInfo] -> ShowS
GlyphInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphInfo] -> ShowS
$cshowList :: [GlyphInfo] -> ShowS
show :: GlyphInfo -> String
$cshow :: GlyphInfo -> String
showsPrec :: Int -> GlyphInfo -> ShowS
$cshowsPrec :: Int -> GlyphInfo -> ShowS
Show)

instance Storable GlyphInfo where
  sizeOf :: GlyphInfo -> Int
sizeOf GlyphInfo
_ = Int
40
  alignment :: GlyphInfo -> Int
alignment GlyphInfo
_ = Int
4
  peek :: Ptr GlyphInfo -> IO GlyphInfo
peek Ptr GlyphInfo
_p = do
    Int
value <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
_p Int
0 :: IO CInt)
    Int
offsetX <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
_p Int
4 :: IO CInt)
    Int
offsetY <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
_p Int
8 :: IO CInt)
    Int
advanceX <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
_p Int
12 :: IO CInt)
    Image
image <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
_p Int
16
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Image -> GlyphInfo
GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image
  poke :: Ptr GlyphInfo -> GlyphInfo -> IO ()
poke Ptr GlyphInfo
_p (GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphInfo
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphInfo
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphInfo
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphInfo
_p Int
12 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
advanceX :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphInfo
_p Int
16 Image
image
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable GlyphInfo where
  rlFreeDependents :: GlyphInfo -> Ptr GlyphInfo -> IO ()
rlFreeDependents GlyphInfo
_ Ptr GlyphInfo
ptr = do
    Ptr CUChar
dataPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphInfo
ptr Int
16 :: IO (Ptr CUChar))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
dataPtr

data Font = Font
  { Font -> Int
font'baseSize :: Int,
    Font -> Int
font'glyphCount :: Int,
    Font -> Int
font'glyphPadding :: Int,
    Font -> Texture
font'texture :: Texture,
    Font -> [Rectangle]
font'recs :: [Rectangle],
    Font -> [GlyphInfo]
font'glyphs :: [GlyphInfo]
  }
  deriving (Font -> Font -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> String
$cshow :: Font -> String
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show)

instance Storable Font where
  sizeOf :: Font -> Int
sizeOf Font
_ = Int
48
  alignment :: Font -> Int
alignment Font
_ = Int
4
  peek :: Ptr Font -> IO Font
peek Ptr Font
_p = do
    Int
baseSize <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
0 :: IO CInt)
    Int
glyphCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
4 :: IO CInt)
    Int
glyphPadding <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
8 :: IO CInt)
    Texture
texture <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
12
    Ptr Rectangle
recPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
32 :: IO (Ptr Rectangle))
    [Rectangle]
recs <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
glyphCount Ptr Rectangle
recPtr
    Ptr GlyphInfo
glyphPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
_p Int
40 :: IO (Ptr GlyphInfo))
    [GlyphInfo]
glyphs <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
glyphCount Ptr GlyphInfo
glyphPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs
  poke :: Ptr Font -> Font -> IO ()
poke Ptr Font
_p (Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
baseSize :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphPadding :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
12 Texture
texture
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
32 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Rectangle]
recs
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Font
_p Int
40 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [GlyphInfo]
glyphs
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Font where
  rlFreeDependents :: Font -> Ptr Font -> IO ()
rlFreeDependents Font
val Ptr Font
ptr = do
    Ptr Rectangle
recsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
ptr Int
32 :: IO (Ptr Rectangle))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
recsPtr
    Ptr GlyphInfo
glyphsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Font
ptr Int
40 :: IO (Ptr GlyphInfo))
    forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray (Font -> [GlyphInfo]
font'glyphs Font
val) Ptr GlyphInfo
glyphsPtr

data Camera3D = Camera3D
  { Camera3D -> Vector3
camera3D'position :: Vector3,
    Camera3D -> Vector3
camera3D'target :: Vector3,
    Camera3D -> Vector3
camera3D'up :: Vector3,
    Camera3D -> Float
camera3D'fovy :: Float,
    Camera3D -> CameraProjection
camera3D'projection :: CameraProjection
  }
  deriving (Camera3D -> Camera3D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Camera3D -> Camera3D -> Bool
$c/= :: Camera3D -> Camera3D -> Bool
== :: Camera3D -> Camera3D -> Bool
$c== :: Camera3D -> Camera3D -> Bool
Eq, Int -> Camera3D -> ShowS
[Camera3D] -> ShowS
Camera3D -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camera3D] -> ShowS
$cshowList :: [Camera3D] -> ShowS
show :: Camera3D -> String
$cshow :: Camera3D -> String
showsPrec :: Int -> Camera3D -> ShowS
$cshowsPrec :: Int -> Camera3D -> ShowS
Show, Camera3D -> Ptr Camera3D -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Camera3D -> Ptr Camera3D -> IO ()
$crlFree :: Camera3D -> Ptr Camera3D -> IO ()
rlFreeDependents :: Camera3D -> Ptr Camera3D -> IO ()
$crlFreeDependents :: Camera3D -> Ptr Camera3D -> IO ()
Freeable)

instance Storable Camera3D where
  sizeOf :: Camera3D -> Int
sizeOf Camera3D
_ = Int
44
  alignment :: Camera3D -> Int
alignment Camera3D
_ = Int
4
  peek :: Ptr Camera3D -> IO Camera3D
peek Ptr Camera3D
_p = do
    Vector3
position <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera3D
_p Int
0
    Vector3
target <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera3D
_p Int
12
    Vector3
up <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera3D
_p Int
24
    Float
fovy <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera3D
_p Int
36 :: IO CFloat)
    CameraProjection
projection <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera3D
_p Int
40
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection
  poke :: Ptr Camera3D -> Camera3D -> IO ()
poke Ptr Camera3D
_p (Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera3D
_p Int
0 Vector3
position
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera3D
_p Int
12 Vector3
target
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera3D
_p Int
24 Vector3
up
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera3D
_p Int
36 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fovy :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera3D
_p Int
40 CameraProjection
projection
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

type Camera = Camera3D

data Camera2D = Camera2D
  { Camera2D -> Vector2
camera2D'offset :: Vector2,
    Camera2D -> Vector2
camera2D'target :: Vector2,
    Camera2D -> Float
camera2D'rotation :: Float,
    Camera2D -> Float
camera2D'zoom :: Float
  }
  deriving (Camera2D -> Camera2D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Camera2D -> Camera2D -> Bool
$c/= :: Camera2D -> Camera2D -> Bool
== :: Camera2D -> Camera2D -> Bool
$c== :: Camera2D -> Camera2D -> Bool
Eq, Int -> Camera2D -> ShowS
[Camera2D] -> ShowS
Camera2D -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camera2D] -> ShowS
$cshowList :: [Camera2D] -> ShowS
show :: Camera2D -> String
$cshow :: Camera2D -> String
showsPrec :: Int -> Camera2D -> ShowS
$cshowsPrec :: Int -> Camera2D -> ShowS
Show, Camera2D -> Ptr Camera2D -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Camera2D -> Ptr Camera2D -> IO ()
$crlFree :: Camera2D -> Ptr Camera2D -> IO ()
rlFreeDependents :: Camera2D -> Ptr Camera2D -> IO ()
$crlFreeDependents :: Camera2D -> Ptr Camera2D -> IO ()
Freeable)

instance Storable Camera2D where
  sizeOf :: Camera2D -> Int
sizeOf Camera2D
_ = Int
24
  alignment :: Camera2D -> Int
alignment Camera2D
_ = Int
4
  peek :: Ptr Camera2D -> IO Camera2D
peek Ptr Camera2D
_p = do
    Vector2
offset <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera2D
_p Int
0
    Vector2
target <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera2D
_p Int
8
    Float
rotation <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera2D
_p Int
16 :: IO CFloat)
    Float
zoom <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Camera2D
_p Int
20 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector2 -> Vector2 -> Float -> Float -> Camera2D
Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom
  poke :: Ptr Camera2D -> Camera2D -> IO ()
poke Ptr Camera2D
_p (Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera2D
_p Int
0 Vector2
offset
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera2D
_p Int
8 Vector2
target
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera2D
_p Int
16 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Camera2D
_p Int
20 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zoom :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Mesh = Mesh
  { Mesh -> Int
mesh'vertexCount :: Int,
    Mesh -> Int
mesh'triangleCount :: Int,
    Mesh -> [Vector3]
mesh'vertices :: [Vector3],
    Mesh -> [Vector2]
mesh'texcoords :: [Vector2],
    Mesh -> Maybe [Vector2]
mesh'texcoords2 :: Maybe [Vector2],
    Mesh -> [Vector3]
mesh'normals :: [Vector3],
    Mesh -> Maybe [Vector4]
mesh'tangents :: Maybe [Vector4],
    Mesh -> Maybe [Color]
mesh'colors :: Maybe [Color],
    Mesh -> Maybe [Word16]
mesh'indices :: Maybe [Word16],
    Mesh -> Maybe [Vector3]
mesh'animVertices :: Maybe [Vector3],
    Mesh -> Maybe [Vector3]
mesh'animNormals :: Maybe [Vector3],
    Mesh -> Maybe [Word8]
mesh'boneIds :: Maybe [Word8],
    Mesh -> Maybe [Float]
mesh'boneWeights :: Maybe [Float],
    Mesh -> Integer
mesh'vaoId :: Integer,
    Mesh -> Maybe [Integer]
mesh'vboId :: Maybe [Integer]
  }
  deriving (Mesh -> Mesh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mesh -> Mesh -> Bool
$c/= :: Mesh -> Mesh -> Bool
== :: Mesh -> Mesh -> Bool
$c== :: Mesh -> Mesh -> Bool
Eq, Int -> Mesh -> ShowS
[Mesh] -> ShowS
Mesh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mesh] -> ShowS
$cshowList :: [Mesh] -> ShowS
show :: Mesh -> String
$cshow :: Mesh -> String
showsPrec :: Int -> Mesh -> ShowS
$cshowsPrec :: Int -> Mesh -> ShowS
Show)

instance Storable Mesh where
  sizeOf :: Mesh -> Int
sizeOf Mesh
_ = Int
112
  alignment :: Mesh -> Int
alignment Mesh
_ = Int
8
  peek :: Ptr Mesh -> IO Mesh
peek Ptr Mesh
_p = do
    Int
vertexCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
0 :: IO CInt)
    Int
triangleCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
4 :: IO CInt)
    Ptr Vector3
verticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
8 :: IO (Ptr Vector3))
    [Vector3]
vertices <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
vertexCount Ptr Vector3
verticesPtr
    Ptr Vector2
texcoordsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
16 :: IO (Ptr Vector2))
    [Vector2]
texcoords <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
vertexCount Ptr Vector2
texcoordsPtr
    Ptr Vector2
texcoords2Ptr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
24 :: IO (Ptr Vector2))
    Maybe [Vector2]
texcoords2 <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr Vector2
texcoords2Ptr
    Ptr Vector3
normalsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
32 :: IO (Ptr Vector3))
    [Vector3]
normals <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
vertexCount Ptr Vector3
normalsPtr
    Ptr Vector4
tangentsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
40 :: IO (Ptr Vector4))
    Maybe [Vector4]
tangents <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr Vector4
tangentsPtr
    Ptr Color
colorsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
48 :: IO (Ptr Color))
    Maybe [Color]
colors <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr Color
colorsPtr
    Ptr CUShort
indicesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
56 :: IO (Ptr CUShort))
    Maybe [Word16]
indices <- (\Maybe [CUShort]
m -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CUShort]
m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr CUShort
indicesPtr
    Ptr Vector3
animVerticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
64 :: IO (Ptr Vector3))
    Maybe [Vector3]
animVertices <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr Vector3
animVerticesPtr
    Ptr Vector3
animNormalsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
72 :: IO (Ptr Vector3))
    Maybe [Vector3]
animNormals <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
vertexCount Ptr Vector3
animNormalsPtr
    Ptr CUChar
boneIdsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
80 :: IO (Ptr CUChar))
    Maybe [Word8]
boneIds <- (\Maybe [CUChar]
m -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CUChar]
m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray (Int
vertexCount forall a. Num a => a -> a -> a
* Int
4) Ptr CUChar
boneIdsPtr
    Ptr CFloat
boneWeightsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
88 :: IO (Ptr CFloat))
    Maybe [Float]
boneWeights <- (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray (Int
vertexCount forall a. Num a => a -> a -> a
* Int
4) Ptr CFloat
boneWeightsPtr
    Integer
vaoId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
96 :: IO CUInt)
    Ptr CUInt
vboIdPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
_p Int
104 :: IO (Ptr CUInt))
    Maybe [Integer]
vboId <- (\Maybe [CUInt]
m -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CUInt]
m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
7 Ptr CUInt
vboIdPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> [Vector3]
-> [Vector2]
-> Maybe [Vector2]
-> [Vector3]
-> Maybe [Vector4]
-> Maybe [Color]
-> Maybe [Word16]
-> Maybe [Vector3]
-> Maybe [Vector3]
-> Maybe [Word8]
-> Maybe [Float]
-> Integer
-> Maybe [Integer]
-> Mesh
Mesh Int
vertexCount Int
triangleCount [Vector3]
vertices [Vector2]
texcoords Maybe [Vector2]
texcoords2 [Vector3]
normals Maybe [Vector4]
tangents Maybe [Color]
colors Maybe [Word16]
indices Maybe [Vector3]
animVertices Maybe [Vector3]
animNormals Maybe [Word8]
boneIds Maybe [Float]
boneWeights Integer
vaoId Maybe [Integer]
vboId
  poke :: Ptr Mesh -> Mesh -> IO ()
poke Ptr Mesh
_p (Mesh Int
vertexCount Int
triangleCount [Vector3]
vertices [Vector2]
texcoords Maybe [Vector2]
texcoords2 [Vector3]
normals Maybe [Vector4]
tangents Maybe [Color]
colors Maybe [Word16]
indices Maybe [Vector3]
animVertices Maybe [Vector3]
animNormals Maybe [Word8]
boneIds Maybe [Float]
boneWeights Integer
vaoId Maybe [Integer]
vboId) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vertexCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
triangleCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Vector3]
vertices
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
16 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Vector2]
texcoords
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Vector2]
texcoords2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
24
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
32 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Vector3]
normals
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Vector4]
tangents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
40
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Color]
colors forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
48
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Word16]
indices :: Maybe [CUShort]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
56
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Vector3]
animVertices forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
64
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Vector3]
animNormals forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
72
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Word8]
boneIds :: Maybe [CUChar]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
80
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Float]
boneWeights :: Maybe [CFloat]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
88
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
96 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vaoId :: CUInt)
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Integer]
vboId :: Maybe [CUInt]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Mesh
_p Int
104
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Mesh where
  rlFreeDependents :: Mesh -> Ptr Mesh -> IO ()
rlFreeDependents Mesh
_ Ptr Mesh
ptr = do
    Ptr Float
verticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
8 :: IO (Ptr Float))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Float
verticesPtr
    Ptr Vector2
texcoordsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
16 :: IO (Ptr Vector2))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector2
texcoordsPtr
    Ptr Vector2
texcoords2Ptr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
24 :: IO (Ptr Vector2))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector2
texcoords2Ptr
    Ptr Vector3
normalsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
32 :: IO (Ptr Vector3))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector3
normalsPtr
    Ptr Vector4
tangentsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
40 :: IO (Ptr Vector4))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector4
tangentsPtr
    Ptr Color
colorsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
48 :: IO (Ptr Color))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Color
colorsPtr
    Ptr CUShort
indicesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
56 :: IO (Ptr CUShort))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUShort
indicesPtr
    Ptr Vector3
animVerticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
64 :: IO (Ptr Vector3))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector3
animVerticesPtr
    Ptr Vector3
animNormalsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
72 :: IO (Ptr Vector3))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector3
animNormalsPtr
    Ptr CUChar
boneIdsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
80 :: IO (Ptr CUChar))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
boneIdsPtr
    Ptr CFloat
boneWeightsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
88 :: IO (Ptr CFloat))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
boneWeightsPtr
    Ptr CUInt
vboIdPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Mesh
ptr Int
104 :: IO (Ptr CUInt))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUInt
vboIdPtr

data Shader = Shader
  { Shader -> Integer
shader'id :: Integer,
    Shader -> [Int]
shader'locs :: [Int]
  }
  deriving (Shader -> Shader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shader -> Shader -> Bool
$c/= :: Shader -> Shader -> Bool
== :: Shader -> Shader -> Bool
$c== :: Shader -> Shader -> Bool
Eq, Int -> Shader -> ShowS
[Shader] -> ShowS
Shader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shader] -> ShowS
$cshowList :: [Shader] -> ShowS
show :: Shader -> String
$cshow :: Shader -> String
showsPrec :: Int -> Shader -> ShowS
$cshowsPrec :: Int -> Shader -> ShowS
Show)

instance Storable Shader where
  sizeOf :: Shader -> Int
sizeOf Shader
_ = Int
16
  alignment :: Shader -> Int
alignment Shader
_ = Int
8
  peek :: Ptr Shader -> IO Shader
peek Ptr Shader
_p = do
    Integer
sId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Shader
_p Int
0 :: IO CUInt)
    Ptr CInt
locsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Shader
_p Int
8 :: IO (Ptr CInt))
    [Int]
locs <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
32 Ptr CInt
locsPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> [Int] -> Shader
Shader Integer
sId [Int]
locs
  poke :: Ptr Shader -> Shader -> IO ()
poke Ptr Shader
_p (Shader Integer
sId [Int]
locs) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Shader
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sId :: CUInt)
    CUInt
defaultShaderId <- IO CUInt
c'rlGetShaderIdDefault
    Ptr CInt
locsArr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
locs :: [CInt])
    if Integer
sId forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
defaultShaderId
      then do
        ForeignPtr CInt
locsPtr <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
p'free Ptr CInt
locsArr
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CInt
locsPtr forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Shader
_p Int
8
      else forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Shader
_p Int
8 Ptr CInt
locsArr
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Shader where
  rlFreeDependents :: Shader -> Ptr Shader -> IO ()
rlFreeDependents Shader
val Ptr Shader
ptr = do
    CUInt
defaultShaderId <- IO CUInt
c'rlGetShaderIdDefault
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
      (Shader -> Integer
shader'id Shader
val forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
defaultShaderId)
      ( do
          Ptr CInt
locsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Shader
ptr Int
8 :: IO (Ptr CInt))
          Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
locsPtr
      )

data MaterialMap = MaterialMap
  { MaterialMap -> Texture
materialMap'texture :: Texture,
    MaterialMap -> Color
materialMap'color :: Color,
    MaterialMap -> Float
materialMap'value :: Float
  }
  deriving (MaterialMap -> MaterialMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaterialMap -> MaterialMap -> Bool
$c/= :: MaterialMap -> MaterialMap -> Bool
== :: MaterialMap -> MaterialMap -> Bool
$c== :: MaterialMap -> MaterialMap -> Bool
Eq, Int -> MaterialMap -> ShowS
[MaterialMap] -> ShowS
MaterialMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaterialMap] -> ShowS
$cshowList :: [MaterialMap] -> ShowS
show :: MaterialMap -> String
$cshow :: MaterialMap -> String
showsPrec :: Int -> MaterialMap -> ShowS
$cshowsPrec :: Int -> MaterialMap -> ShowS
Show, MaterialMap -> Ptr MaterialMap -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: MaterialMap -> Ptr MaterialMap -> IO ()
$crlFree :: MaterialMap -> Ptr MaterialMap -> IO ()
rlFreeDependents :: MaterialMap -> Ptr MaterialMap -> IO ()
$crlFreeDependents :: MaterialMap -> Ptr MaterialMap -> IO ()
Freeable)

instance Storable MaterialMap where
  sizeOf :: MaterialMap -> Int
sizeOf MaterialMap
_ = Int
28
  alignment :: MaterialMap -> Int
alignment MaterialMap
_ = Int
4
  peek :: Ptr MaterialMap -> IO MaterialMap
peek Ptr MaterialMap
_p = do
    Texture
texture <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MaterialMap
_p Int
0
    Color
color <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MaterialMap
_p Int
20
    Float
value <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MaterialMap
_p Int
24 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Texture -> Color -> Float -> MaterialMap
MaterialMap Texture
texture Color
color Float
value
  poke :: Ptr MaterialMap -> MaterialMap -> IO ()
poke Ptr MaterialMap
_p (MaterialMap Texture
texture Color
color Float
value) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MaterialMap
_p Int
0 Texture
texture
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MaterialMap
_p Int
20 Color
color
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MaterialMap
_p Int
24 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Material = Material
  { Material -> Shader
material'shader :: Shader,
    Material -> Maybe [MaterialMap]
material'maps :: Maybe [MaterialMap],
    Material -> [Float]
material'params :: [Float]
  }
  deriving (Material -> Material -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Material -> Material -> Bool
$c/= :: Material -> Material -> Bool
== :: Material -> Material -> Bool
$c== :: Material -> Material -> Bool
Eq, Int -> Material -> ShowS
[Material] -> ShowS
Material -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Material] -> ShowS
$cshowList :: [Material] -> ShowS
show :: Material -> String
$cshow :: Material -> String
showsPrec :: Int -> Material -> ShowS
$cshowsPrec :: Int -> Material -> ShowS
Show)

instance Storable Material where
  sizeOf :: Material -> Int
sizeOf Material
_ = Int
40
  alignment :: Material -> Int
alignment Material
_ = Int
8
  peek :: Ptr Material -> IO Material
peek Ptr Material
_p = do
    Shader
shader <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Material
_p Int
0
    Ptr MaterialMap
mapsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Material
_p Int
16 :: IO (Ptr MaterialMap))
    Maybe [MaterialMap]
maps <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
12 Ptr MaterialMap
mapsPtr
    [Float]
params <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
4 (forall a b. Ptr a -> Ptr b
castPtr Ptr Material
_p :: Ptr CFloat) Int
24
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Shader -> Maybe [MaterialMap] -> [Float] -> Material
Material Shader
shader Maybe [MaterialMap]
maps [Float]
params
  poke :: Ptr Material -> Material -> IO ()
poke Ptr Material
_p (Material Shader
shader Maybe [MaterialMap]
maps [Float]
params) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Material
_p Int
0 Shader
shader
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Material
_p Int
16 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [MaterialMap]
maps
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Material
_p :: Ptr CFloat) Int
24 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
params :: [CFloat])
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Material where
  rlFreeDependents :: Material -> Ptr Material -> IO ()
rlFreeDependents Material
val Ptr Material
ptr = do
    forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents (Material -> Shader
material'shader Material
val) (forall a b. Ptr a -> Ptr b
castPtr Ptr Material
ptr :: Ptr Shader)
    Ptr MaterialMap
mapsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Material
ptr Int
16 :: IO (Ptr MaterialMap))
    forall a. (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
rlFreeMaybeArray (Material -> Maybe [MaterialMap]
material'maps Material
val) Ptr MaterialMap
mapsPtr

data Transform = Transform
  { Transform -> Vector3
transform'translation :: Vector3,
    Transform -> Vector4
transform'rotation :: Quaternion,
    Transform -> Vector3
transform'scale :: Vector3
  }
  deriving (Transform -> Transform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transform -> Transform -> Bool
$c/= :: Transform -> Transform -> Bool
== :: Transform -> Transform -> Bool
$c== :: Transform -> Transform -> Bool
Eq, Int -> Transform -> ShowS
[Transform] -> ShowS
Transform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform] -> ShowS
$cshowList :: [Transform] -> ShowS
show :: Transform -> String
$cshow :: Transform -> String
showsPrec :: Int -> Transform -> ShowS
$cshowsPrec :: Int -> Transform -> ShowS
Show, Transform -> Ptr Transform -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Transform -> Ptr Transform -> IO ()
$crlFree :: Transform -> Ptr Transform -> IO ()
rlFreeDependents :: Transform -> Ptr Transform -> IO ()
$crlFreeDependents :: Transform -> Ptr Transform -> IO ()
Freeable)

instance Storable Transform where
  sizeOf :: Transform -> Int
sizeOf Transform
_ = Int
40
  alignment :: Transform -> Int
alignment Transform
_ = Int
4
  peek :: Ptr Transform -> IO Transform
peek Ptr Transform
_p = do
    Vector3
translation <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Transform
_p Int
0
    Vector4
rotation <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Transform
_p Int
12
    Vector3
scale <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Transform
_p Int
28
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector3 -> Vector4 -> Vector3 -> Transform
Transform Vector3
translation Vector4
rotation Vector3
scale
  poke :: Ptr Transform -> Transform -> IO ()
poke Ptr Transform
_p (Transform Vector3
translation Vector4
rotation Vector3
scale) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Transform
_p Int
0 Vector3
translation
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Transform
_p Int
12 Vector4
rotation
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Transform
_p Int
28 Vector3
scale
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data BoneInfo = BoneInfo
  { BoneInfo -> String
boneInfo'name :: String,
    BoneInfo -> Int
boneinfo'parent :: Int
  }
  deriving (BoneInfo -> BoneInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoneInfo -> BoneInfo -> Bool
$c/= :: BoneInfo -> BoneInfo -> Bool
== :: BoneInfo -> BoneInfo -> Bool
$c== :: BoneInfo -> BoneInfo -> Bool
Eq, Int -> BoneInfo -> ShowS
[BoneInfo] -> ShowS
BoneInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoneInfo] -> ShowS
$cshowList :: [BoneInfo] -> ShowS
show :: BoneInfo -> String
$cshow :: BoneInfo -> String
showsPrec :: Int -> BoneInfo -> ShowS
$cshowsPrec :: Int -> BoneInfo -> ShowS
Show, BoneInfo -> Ptr BoneInfo -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: BoneInfo -> Ptr BoneInfo -> IO ()
$crlFree :: BoneInfo -> Ptr BoneInfo -> IO ()
rlFreeDependents :: BoneInfo -> Ptr BoneInfo -> IO ()
$crlFreeDependents :: BoneInfo -> Ptr BoneInfo -> IO ()
Freeable)

instance Storable BoneInfo where
  sizeOf :: BoneInfo -> Int
sizeOf BoneInfo
_ = Int
36
  alignment :: BoneInfo -> Int
alignment BoneInfo
_ = Int
4
  peek :: Ptr BoneInfo -> IO BoneInfo
peek Ptr BoneInfo
_p = do
    String
name <- forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= CChar
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
32 (forall a b. Ptr a -> Ptr b
castPtr Ptr BoneInfo
_p :: Ptr CChar)
    Int
parent <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BoneInfo
_p Int
32 :: IO CInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Int -> BoneInfo
BoneInfo String
name Int
parent
  poke :: Ptr BoneInfo -> BoneInfo -> IO ()
poke Ptr BoneInfo
_p (BoneInfo String
name Int
parent) = do
    forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (forall a b. Ptr a -> Ptr b
castPtr Ptr BoneInfo
_p :: Ptr CChar) (forall a. Int -> a -> [a] -> [a]
rightPad Int
32 CChar
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
name)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr BoneInfo
_p Int
32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parent :: CInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Model = Model
  { Model -> Matrix
model'transform :: Matrix,
    Model -> [Mesh]
model'meshes :: [Mesh],
    Model -> [Material]
model'materials :: [Material],
    Model -> [Int]
model'meshMaterial :: [Int],
    Model -> Int
model'boneCount :: Int,
    Model -> Maybe [BoneInfo]
model'bones :: Maybe [BoneInfo],
    Model -> Maybe [Transform]
model'bindPose :: Maybe [Transform]
  }
  deriving (Model -> Model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
Eq, Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> String
$cshow :: Model -> String
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
Show)

instance Storable Model where
  sizeOf :: Model -> Int
sizeOf Model
_ = Int
120
  alignment :: Model -> Int
alignment Model
_ = Int
4
  peek :: Ptr Model -> IO Model
peek Ptr Model
_p = do
    Matrix
transform <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
0
    Int
meshCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
64 :: IO CInt)
    Int
materialCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
68 :: IO CInt)
    Ptr Mesh
meshesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
72 :: IO (Ptr Mesh))
    [Mesh]
meshes <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
meshCount Ptr Mesh
meshesPtr
    Ptr Material
materialsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
80 :: IO (Ptr Material))
    [Material]
materials <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
materialCount Ptr Material
materialsPtr
    Ptr CInt
meshMaterialPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
88 :: IO (Ptr CInt))
    [Int]
meshMaterial <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
meshCount Ptr CInt
meshMaterialPtr
    Int
boneCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
96 :: IO CInt)
    Ptr BoneInfo
bonesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
104 :: IO (Ptr BoneInfo))
    Maybe [BoneInfo]
bones <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
boneCount Ptr BoneInfo
bonesPtr
    Ptr Transform
bindPosePtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
_p Int
112 :: IO (Ptr Transform))
    Maybe [Transform]
bindPose <- forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
boneCount Ptr Transform
bindPosePtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Matrix
-> [Mesh]
-> [Material]
-> [Int]
-> Int
-> Maybe [BoneInfo]
-> Maybe [Transform]
-> Model
Model Matrix
transform [Mesh]
meshes [Material]
materials [Int]
meshMaterial Int
boneCount Maybe [BoneInfo]
bones Maybe [Transform]
bindPose
  poke :: Ptr Model -> Model -> IO ()
poke Ptr Model
_p (Model Matrix
transform [Mesh]
meshes [Material]
materials [Int]
meshMaterial Int
boneCount Maybe [BoneInfo]
bones Maybe [Transform]
bindPose) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
0 Matrix
transform
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mesh]
meshes :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
68 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Material]
materials :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
72 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Mesh]
meshes
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
80 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Material]
materials
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
88 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
meshMaterial :: [CInt])
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
96 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
boneCount :: CInt)
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [BoneInfo]
bones forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
104
    forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [Transform]
bindPose forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Model
_p Int
112
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Model where
  rlFreeDependents :: Model -> Ptr Model -> IO ()
rlFreeDependents Model
val Ptr Model
ptr = do
    Ptr Mesh
meshesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
ptr Int
72 :: IO (Ptr Mesh))
    forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray (Model -> [Mesh]
model'meshes Model
val) Ptr Mesh
meshesPtr
    Ptr Material
materialsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
ptr Int
80 :: IO (Ptr Material))
    forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray (Model -> [Material]
model'materials Model
val) Ptr Material
materialsPtr
    Ptr CInt
meshMaterialPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
ptr Int
88 :: IO (Ptr CInt))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
meshMaterialPtr
    Ptr BoneInfo
bonesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
ptr Int
104 :: IO (Ptr BoneInfo))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr BoneInfo
bonesPtr
    Ptr Transform
bindPosePtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Model
ptr Int
112 :: IO (Ptr Transform))
    Ptr () -> IO ()
freeMaybePtr forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Transform
bindPosePtr

data ModelAnimation = ModelAnimation
  { ModelAnimation -> Int
modelAnimation'boneCount :: Int,
    ModelAnimation -> Int
modelAnimation'frameCount :: Int,
    ModelAnimation -> [BoneInfo]
modelAnimation'bones :: [BoneInfo],
    ModelAnimation -> [[Transform]]
modelAnimation'framePoses :: [[Transform]]
  }
  deriving (ModelAnimation -> ModelAnimation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelAnimation -> ModelAnimation -> Bool
$c/= :: ModelAnimation -> ModelAnimation -> Bool
== :: ModelAnimation -> ModelAnimation -> Bool
$c== :: ModelAnimation -> ModelAnimation -> Bool
Eq, Int -> ModelAnimation -> ShowS
[ModelAnimation] -> ShowS
ModelAnimation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelAnimation] -> ShowS
$cshowList :: [ModelAnimation] -> ShowS
show :: ModelAnimation -> String
$cshow :: ModelAnimation -> String
showsPrec :: Int -> ModelAnimation -> ShowS
$cshowsPrec :: Int -> ModelAnimation -> ShowS
Show)

instance Storable ModelAnimation where
  sizeOf :: ModelAnimation -> Int
sizeOf ModelAnimation
_ = Int
24
  alignment :: ModelAnimation -> Int
alignment ModelAnimation
_ = Int
4
  peek :: Ptr ModelAnimation -> IO ModelAnimation
peek Ptr ModelAnimation
_p = do
    Int
boneCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
_p Int
0 :: IO CInt)
    Int
frameCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
_p Int
4 :: IO CInt)
    Ptr BoneInfo
bonesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
_p Int
8 :: IO (Ptr BoneInfo))
    [BoneInfo]
bones <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
boneCount Ptr BoneInfo
bonesPtr
    Ptr (Ptr Transform)
framePosesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
_p Int
16 :: IO (Ptr (Ptr Transform)))
    [Ptr Transform]
framePosesPtrArr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
frameCount Ptr (Ptr Transform)
framePosesPtr
    [[Transform]]
framePoses <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
boneCount) [Ptr Transform]
framePosesPtrArr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> [BoneInfo] -> [[Transform]] -> ModelAnimation
ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses
  poke :: Ptr ModelAnimation -> ModelAnimation -> IO ()
poke Ptr ModelAnimation
_p (ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ModelAnimation
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
boneCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ModelAnimation
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ModelAnimation
_p Int
8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [BoneInfo]
bones
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Storable a => [a] -> IO (Ptr a)
newArray [[Transform]]
framePoses forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => [a] -> IO (Ptr a)
newArray forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ModelAnimation
_p Int
16
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable ModelAnimation where
  rlFreeDependents :: ModelAnimation -> Ptr ModelAnimation -> IO ()
rlFreeDependents ModelAnimation
val Ptr ModelAnimation
ptr = do
    Ptr BoneInfo
bonesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
ptr Int
8 :: IO (Ptr BoneInfo))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr BoneInfo
bonesPtr
    Ptr (Ptr Transform)
framePosesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ModelAnimation
ptr Int
16 :: IO (Ptr (Ptr Transform)))
    [Ptr Transform]
framePosesPtrArr <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (ModelAnimation -> Int
modelAnimation'frameCount ModelAnimation
val) Ptr (Ptr Transform)
framePosesPtr
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Ptr Transform]
framePosesPtrArr (Ptr () -> IO ()
c'free forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Transform)
framePosesPtr

data Ray = Ray
  { Ray -> Vector3
ray'position :: Vector3,
    Ray -> Vector3
ray'direction :: Vector3
  }
  deriving (Ray -> Ray -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ray -> Ray -> Bool
$c/= :: Ray -> Ray -> Bool
== :: Ray -> Ray -> Bool
$c== :: Ray -> Ray -> Bool
Eq, Int -> Ray -> ShowS
[Ray] -> ShowS
Ray -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ray] -> ShowS
$cshowList :: [Ray] -> ShowS
show :: Ray -> String
$cshow :: Ray -> String
showsPrec :: Int -> Ray -> ShowS
$cshowsPrec :: Int -> Ray -> ShowS
Show, Ray -> Ptr Ray -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Ray -> Ptr Ray -> IO ()
$crlFree :: Ray -> Ptr Ray -> IO ()
rlFreeDependents :: Ray -> Ptr Ray -> IO ()
$crlFreeDependents :: Ray -> Ptr Ray -> IO ()
Freeable)

instance Storable Ray where
  sizeOf :: Ray -> Int
sizeOf Ray
_ = Int
24
  alignment :: Ray -> Int
alignment Ray
_ = Int
4
  peek :: Ptr Ray -> IO Ray
peek Ptr Ray
_p = do
    Vector3
position <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Ray
_p Int
0
    Vector3
direction <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Ray
_p Int
12
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector3 -> Vector3 -> Ray
Ray Vector3
position Vector3
direction
  poke :: Ptr Ray -> Ray -> IO ()
poke Ptr Ray
_p (Ray Vector3
position Vector3
direction) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Ray
_p Int
0 Vector3
position
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Ray
_p Int
12 Vector3
direction
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data RayCollision = RayCollision
  { RayCollision -> Bool
rayCollision'hit :: Bool,
    RayCollision -> Float
rayCollision'distance :: Float,
    RayCollision -> Vector3
rayCollision'point :: Vector3,
    RayCollision -> Vector3
rayCollision'normal :: Vector3
  }
  deriving (RayCollision -> RayCollision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RayCollision -> RayCollision -> Bool
$c/= :: RayCollision -> RayCollision -> Bool
== :: RayCollision -> RayCollision -> Bool
$c== :: RayCollision -> RayCollision -> Bool
Eq, Int -> RayCollision -> ShowS
[RayCollision] -> ShowS
RayCollision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RayCollision] -> ShowS
$cshowList :: [RayCollision] -> ShowS
show :: RayCollision -> String
$cshow :: RayCollision -> String
showsPrec :: Int -> RayCollision -> ShowS
$cshowsPrec :: Int -> RayCollision -> ShowS
Show, RayCollision -> Ptr RayCollision -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: RayCollision -> Ptr RayCollision -> IO ()
$crlFree :: RayCollision -> Ptr RayCollision -> IO ()
rlFreeDependents :: RayCollision -> Ptr RayCollision -> IO ()
$crlFreeDependents :: RayCollision -> Ptr RayCollision -> IO ()
Freeable)

instance Storable RayCollision where
  sizeOf :: RayCollision -> Int
sizeOf RayCollision
_ = Int
32
  alignment :: RayCollision -> Int
alignment RayCollision
_ = Int
4
  peek :: Ptr RayCollision -> IO RayCollision
peek Ptr RayCollision
_p = do
    Bool
hit <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RayCollision
_p Int
0 :: IO CBool)
    Float
distance <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RayCollision
_p Int
4 :: IO CFloat)
    Vector3
point <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RayCollision
_p Int
8
    Vector3
normal <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RayCollision
_p Int
20
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Float -> Vector3 -> Vector3 -> RayCollision
RayCollision Bool
hit Float
distance Vector3
point Vector3
normal
  poke :: Ptr RayCollision -> RayCollision -> IO ()
poke Ptr RayCollision
_p (RayCollision Bool
hit Float
distance Vector3
point Vector3
normal) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RayCollision
_p Int
0 (forall a. Num a => Bool -> a
fromBool Bool
hit :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RayCollision
_p Int
4 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
distance :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RayCollision
_p Int
8 Vector3
point
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RayCollision
_p Int
20 Vector3
normal
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data BoundingBox = BoundingBox
  { BoundingBox -> Vector3
boundingBox'min :: Vector3,
    BoundingBox -> Vector3
boundingBox'max :: Vector3
  }
  deriving (BoundingBox -> BoundingBox -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundingBox -> BoundingBox -> Bool
$c/= :: BoundingBox -> BoundingBox -> Bool
== :: BoundingBox -> BoundingBox -> Bool
$c== :: BoundingBox -> BoundingBox -> Bool
Eq, Int -> BoundingBox -> ShowS
[BoundingBox] -> ShowS
BoundingBox -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundingBox] -> ShowS
$cshowList :: [BoundingBox] -> ShowS
show :: BoundingBox -> String
$cshow :: BoundingBox -> String
showsPrec :: Int -> BoundingBox -> ShowS
$cshowsPrec :: Int -> BoundingBox -> ShowS
Show, BoundingBox -> Ptr BoundingBox -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: BoundingBox -> Ptr BoundingBox -> IO ()
$crlFree :: BoundingBox -> Ptr BoundingBox -> IO ()
rlFreeDependents :: BoundingBox -> Ptr BoundingBox -> IO ()
$crlFreeDependents :: BoundingBox -> Ptr BoundingBox -> IO ()
Freeable)

instance Storable BoundingBox where
  sizeOf :: BoundingBox -> Int
sizeOf BoundingBox
_ = Int
24
  alignment :: BoundingBox -> Int
alignment BoundingBox
_ = Int
4
  peek :: Ptr BoundingBox -> IO BoundingBox
peek Ptr BoundingBox
_p = do
    Vector3
bMin <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BoundingBox
_p Int
0
    Vector3
bMax <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr BoundingBox
_p Int
12
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector3 -> Vector3 -> BoundingBox
BoundingBox Vector3
bMin Vector3
bMax
  poke :: Ptr BoundingBox -> BoundingBox -> IO ()
poke Ptr BoundingBox
_p (BoundingBox Vector3
bMin Vector3
bMax) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr BoundingBox
_p Int
0 Vector3
bMin
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr BoundingBox
_p Int
12 Vector3
bMax
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Wave = Wave
  { Wave -> Integer
wave'frameCount :: Integer,
    Wave -> Integer
wave'sampleRate :: Integer,
    Wave -> Integer
wave'sampleSize :: Integer,
    Wave -> Integer
wave'channels :: Integer,
    Wave -> [Int]
wave'data :: [Int]
  }
  deriving (Wave -> Wave -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wave -> Wave -> Bool
$c/= :: Wave -> Wave -> Bool
== :: Wave -> Wave -> Bool
$c== :: Wave -> Wave -> Bool
Eq, Int -> Wave -> ShowS
[Wave] -> ShowS
Wave -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wave] -> ShowS
$cshowList :: [Wave] -> ShowS
show :: Wave -> String
$cshow :: Wave -> String
showsPrec :: Int -> Wave -> ShowS
$cshowsPrec :: Int -> Wave -> ShowS
Show)

instance Storable Wave where
  sizeOf :: Wave -> Int
sizeOf Wave
_ = Int
24
  alignment :: Wave -> Int
alignment Wave
_ = Int
4
  peek :: Ptr Wave -> IO Wave
peek Ptr Wave
_p = do
    Integer
frameCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
_p Int
0 :: IO CUInt)
    Integer
sampleRate <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
_p Int
4 :: IO CUInt)
    Integer
sampleSize <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
_p Int
8 :: IO CUInt)
    Integer
channels <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
_p Int
12 :: IO CUInt)
    Ptr CShort
wDataPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
_p Int
16 :: IO (Ptr CShort))
    [Int]
wData <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Integer
frameCount forall a. Num a => a -> a -> a
* Integer
channels) Ptr CShort
wDataPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
wData
  poke :: Ptr Wave -> Wave -> IO ()
poke Ptr Wave
_p (Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
wData) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Wave
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frameCount :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Wave
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleRate :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Wave
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleSize :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Wave
_p Int
12 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
channels :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Wave
_p Int
16 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
wData :: [CShort])
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable Wave where
  rlFreeDependents :: Wave -> Ptr Wave -> IO ()
rlFreeDependents Wave
_ Ptr Wave
ptr = do
    Ptr CShort
dataPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Wave
ptr Int
16 :: IO (Ptr CShort)
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CShort
dataPtr

-- RAudioBuffer/Processor don't work perfectly right now, I need to fix them later on.

-- They are currently used as `Ptr`s because peeking/poking them every time

-- an audio function is called doesn't work properly (they are stored in a

-- linked list in C, which makes it very difficult to properly marshal them)

data RAudioBuffer = RAudioBuffer
  { RAudioBuffer -> [Int]
rAudioBuffer'converter :: [Int], -- Implemented as an array of 39 integers because binding the entire `ma_data_converter` type is too painful

    RAudioBuffer -> AudioCallback
rAudioBuffer'callback :: AudioCallback,
    RAudioBuffer -> Maybe RAudioProcessor
rAudioBuffer'processor :: Maybe RAudioProcessor,
    RAudioBuffer -> Float
rAudioBuffer'volume :: Float,
    RAudioBuffer -> Float
rAudioBuffer'pitch :: Float,
    RAudioBuffer -> Float
rAudioBuffer'pan :: Float,
    RAudioBuffer -> Bool
rAudioBuffer'playing :: Bool,
    RAudioBuffer -> Bool
rAudioBuffer'paused :: Bool,
    RAudioBuffer -> Bool
rAudioBuffer'looping :: Bool,
    RAudioBuffer -> Int
rAudioBuffer'usage :: Int,
    RAudioBuffer -> [Bool]
rAudioBuffer'isSubBufferProcessed :: [Bool],
    RAudioBuffer -> Integer
rAudioBuffer'sizeInFrames :: Integer,
    RAudioBuffer -> Integer
rAudioBuffer'frameCursorPos :: Integer,
    RAudioBuffer -> Integer
rAudioBuffer'framesProcessed :: Integer,
    RAudioBuffer -> [Word8]
rAudioBuffer'data :: [Word8],
    RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'next :: Maybe RAudioBuffer,
    RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'prev :: Maybe RAudioBuffer
  }
  deriving (RAudioBuffer -> RAudioBuffer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RAudioBuffer -> RAudioBuffer -> Bool
$c/= :: RAudioBuffer -> RAudioBuffer -> Bool
== :: RAudioBuffer -> RAudioBuffer -> Bool
$c== :: RAudioBuffer -> RAudioBuffer -> Bool
Eq, Int -> RAudioBuffer -> ShowS
[RAudioBuffer] -> ShowS
RAudioBuffer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RAudioBuffer] -> ShowS
$cshowList :: [RAudioBuffer] -> ShowS
show :: RAudioBuffer -> String
$cshow :: RAudioBuffer -> String
showsPrec :: Int -> RAudioBuffer -> ShowS
$cshowsPrec :: Int -> RAudioBuffer -> ShowS
Show, RAudioBuffer -> Ptr RAudioBuffer -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: RAudioBuffer -> Ptr RAudioBuffer -> IO ()
$crlFree :: RAudioBuffer -> Ptr RAudioBuffer -> IO ()
rlFreeDependents :: RAudioBuffer -> Ptr RAudioBuffer -> IO ()
$crlFreeDependents :: RAudioBuffer -> Ptr RAudioBuffer -> IO ()
Freeable)

instance Storable RAudioBuffer where
  sizeOf :: RAudioBuffer -> Int
sizeOf RAudioBuffer
_ = Int
392
  alignment :: RAudioBuffer -> Int
alignment RAudioBuffer
_ = Int
8
  peek :: Ptr RAudioBuffer -> IO RAudioBuffer
peek Ptr RAudioBuffer
_p = do
    Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base <- forall {b}.
Ptr b
-> IO (Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer)
loadBase Ptr RAudioBuffer
_p
    Ptr Any
nextPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RAudioBuffer
_p Int
376
    Maybe RAudioBuffer
next <- forall {b}. Ptr b -> IO (Maybe RAudioBuffer)
loadNext Ptr Any
nextPtr
    Ptr Any
prevPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RAudioBuffer
_p Int
384
    Maybe RAudioBuffer
prev <- forall {b}. Ptr b -> IO (Maybe RAudioBuffer)
loadPrev Ptr Any
prevPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      let p :: RAudioBuffer
p =
            Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base
              ((\RAudioBuffer
a -> RAudioBuffer
a {rAudioBuffer'prev :: Maybe RAudioBuffer
rAudioBuffer'prev = forall a. a -> Maybe a
Just RAudioBuffer
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioBuffer
next)
              ((\RAudioBuffer
a -> RAudioBuffer
a {rAudioBuffer'next :: Maybe RAudioBuffer
rAudioBuffer'next = forall a. a -> Maybe a
Just RAudioBuffer
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioBuffer
prev)
       in RAudioBuffer
p
    where
      getBytesPerSample :: Int -> Integer
getBytesPerSample = ([Integer
0, Integer
1, Integer
2, Integer
3, Integer
4, Integer
4] forall a. [a] -> Int -> a
!!)
      loadBase :: Ptr b
-> IO (Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer)
loadBase Ptr b
ptr = do
        [Int]
converter <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
39 (forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) :: IO [CInt])
        AudioCallback
callback <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
312
        Ptr RAudioProcessor
pPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
320 :: IO (Ptr RAudioProcessor)
        Maybe RAudioProcessor
processor <- if Ptr RAudioProcessor
pPtr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr RAudioProcessor
pPtr

        Float
volume <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
328 :: IO CFloat)
        Float
pitch <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
332 :: IO CFloat)
        Float
pan <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
336 :: IO CFloat)

        Bool
playing <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
340 :: IO CBool)
        Bool
paused <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
341 :: IO CBool)
        Bool
looping <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
342 :: IO CBool)
        Int
usage <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
344 :: IO CInt)

        [Bool]
isSubBufferProcessed <- forall a b. (a -> b) -> [a] -> [b]
map forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr :: Ptr CBool) Int
348
        Integer
sizeInFrames <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
352 :: IO CUInt)
        Integer
frameCursorPos <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
356 :: IO CUInt)
        Integer
framesProcessed <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
360 :: IO CUInt)

        [Word8]
bData <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
sizeInFrames forall a. Num a => a -> a -> a
* Integer
2 forall a. Num a => a -> a -> a
* Int -> Integer
getBytesPerSample (forall a. [a] -> a
head [Int]
converter)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
368 :: IO (Ptr CUChar)))

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int]
-> AudioCallback
-> Maybe RAudioProcessor
-> Float
-> Float
-> Float
-> Bool
-> Bool
-> Bool
-> Int
-> [Bool]
-> Integer
-> Integer
-> Integer
-> [Word8]
-> Maybe RAudioBuffer
-> Maybe RAudioBuffer
-> RAudioBuffer
RAudioBuffer [Int]
converter AudioCallback
callback Maybe RAudioProcessor
processor Float
volume Float
pitch Float
pan Bool
playing Bool
paused Bool
looping Int
usage [Bool]
isSubBufferProcessed Integer
sizeInFrames Integer
frameCursorPos Integer
framesProcessed [Word8]
bData
      loadNext :: Ptr b -> IO (Maybe RAudioBuffer)
loadNext Ptr b
ptr =
        if Ptr b
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else do
            Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base <- forall {b}.
Ptr b
-> IO (Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer)
loadBase Ptr b
ptr
            Ptr b
nextPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
376
            Maybe RAudioBuffer
next <- Ptr b -> IO (Maybe RAudioBuffer)
loadNext Ptr b
nextPtr
            let p :: RAudioBuffer
p = Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base ((\RAudioBuffer
a -> RAudioBuffer
a {rAudioBuffer'prev :: Maybe RAudioBuffer
rAudioBuffer'prev = forall a. a -> Maybe a
Just RAudioBuffer
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioBuffer
next) forall a. Maybe a
Nothing
             in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just RAudioBuffer
p)

      loadPrev :: Ptr b -> IO (Maybe RAudioBuffer)
loadPrev Ptr b
ptr =
        if Ptr b
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else do
            Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base <- forall {b}.
Ptr b
-> IO (Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer)
loadBase Ptr b
ptr
            Ptr b
prevPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
384
            Maybe RAudioBuffer
prev <- Ptr b -> IO (Maybe RAudioBuffer)
loadPrev Ptr b
prevPtr
            let p :: RAudioBuffer
p = Maybe RAudioBuffer -> Maybe RAudioBuffer -> RAudioBuffer
base forall a. Maybe a
Nothing ((\RAudioBuffer
a -> RAudioBuffer
a {rAudioBuffer'next :: Maybe RAudioBuffer
rAudioBuffer'next = forall a. a -> Maybe a
Just RAudioBuffer
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioBuffer
prev)
             in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just RAudioBuffer
p)
  poke :: Ptr RAudioBuffer -> RAudioBuffer -> IO ()
poke Ptr RAudioBuffer
_p RAudioBuffer
a = do
    forall {b}. Ptr b -> RAudioBuffer -> IO ()
pokeBase Ptr RAudioBuffer
_p RAudioBuffer
a
    forall {b}. Storable b => Ptr b -> Maybe RAudioBuffer -> IO ()
pokeNext Ptr RAudioBuffer
_p forall a b. (a -> b) -> a -> b
$ RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'next RAudioBuffer
a
    forall {b}. Storable b => Ptr b -> Maybe RAudioBuffer -> IO ()
pokePrev Ptr RAudioBuffer
_p forall a b. (a -> b) -> a -> b
$ RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'prev RAudioBuffer
a
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      pokeBase :: Ptr b -> RAudioBuffer -> IO ()
pokeBase Ptr b
ptr (RAudioBuffer [Int]
converter AudioCallback
callback Maybe RAudioProcessor
processor Float
volume Float
pitch Float
pan Bool
playing Bool
paused Bool
looping Int
usage [Bool]
isSubBufferProcessed Integer
sizeInFrames Integer
frameCursorPos Integer
framesProcessed [Word8]
bData Maybe RAudioBuffer
_ Maybe RAudioBuffer
_) = do
        forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
converter :: [CInt])
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
312 AudioCallback
callback
        forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff (forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) Int
320 Maybe RAudioProcessor
processor

        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
328 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
volume :: CFloat)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
332 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pitch :: CFloat)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
336 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pan :: CFloat)

        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
340 (forall a. Num a => Bool -> a
fromBool Bool
playing :: CBool)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
341 (forall a. Num a => Bool -> a
fromBool Bool
paused :: CBool)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
342 (forall a. Num a => Bool -> a
fromBool Bool
looping :: CBool)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
344 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
usage :: CInt)

        forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) Int
348 (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => Bool -> a
fromBool [Bool]
isSubBufferProcessed :: [CBool])
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
352 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sizeInFrames :: CUInt)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
356 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frameCursorPos :: CUInt)
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
360 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
framesProcessed :: CUInt)

        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
ptr Int
368 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8]
bData :: [CUChar])

        forall (m :: * -> *) a. Monad m => a -> m a
return ()
      pokeNext :: Ptr b -> Maybe RAudioBuffer -> IO ()
pokeNext Ptr b
basePtr Maybe RAudioBuffer
pNext =
        case Maybe RAudioBuffer
pNext of
          Maybe RAudioBuffer
Nothing -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
basePtr Int
376 forall a. Ptr a
nullPtr
          Just RAudioBuffer
val -> do
            Ptr b
nextPtr <- forall a. Storable a => IO (Ptr a)
malloc
            forall {b}. Ptr b -> RAudioBuffer -> IO ()
pokeBase Ptr b
nextPtr RAudioBuffer
val
            Ptr b -> Maybe RAudioBuffer -> IO ()
pokeNext Ptr b
nextPtr (RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'next RAudioBuffer
val)
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
nextPtr Int
384 Ptr b
basePtr
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
basePtr Int
376 Ptr b
nextPtr
      pokePrev :: Ptr b -> Maybe RAudioBuffer -> IO ()
pokePrev Ptr b
basePtr Maybe RAudioBuffer
pPrev =
        case Maybe RAudioBuffer
pPrev of
          Maybe RAudioBuffer
Nothing -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
basePtr Int
384 forall a. Ptr a
nullPtr
          Just RAudioBuffer
val -> do
            Ptr b
prevPtr <- forall a. Storable a => IO (Ptr a)
malloc
            forall {b}. Ptr b -> RAudioBuffer -> IO ()
pokeBase Ptr b
prevPtr RAudioBuffer
val
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
prevPtr Int
376 Ptr b
basePtr
            Ptr b -> Maybe RAudioBuffer -> IO ()
pokePrev Ptr b
prevPtr (RAudioBuffer -> Maybe RAudioBuffer
rAudioBuffer'prev RAudioBuffer
val)
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
basePtr Int
384 Ptr b
prevPtr

data RAudioProcessor = RAudioProcessor
  { RAudioProcessor -> Maybe AudioCallback
rAudioProcessor'process :: Maybe AudioCallback,
    RAudioProcessor -> Maybe RAudioProcessor
rAudioProcessor'next :: Maybe RAudioProcessor,
    RAudioProcessor -> Maybe RAudioProcessor
rAudioProcessor'prev :: Maybe RAudioProcessor
  }
  deriving (RAudioProcessor -> RAudioProcessor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RAudioProcessor -> RAudioProcessor -> Bool
$c/= :: RAudioProcessor -> RAudioProcessor -> Bool
== :: RAudioProcessor -> RAudioProcessor -> Bool
$c== :: RAudioProcessor -> RAudioProcessor -> Bool
Eq, Int -> RAudioProcessor -> ShowS
[RAudioProcessor] -> ShowS
RAudioProcessor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RAudioProcessor] -> ShowS
$cshowList :: [RAudioProcessor] -> ShowS
show :: RAudioProcessor -> String
$cshow :: RAudioProcessor -> String
showsPrec :: Int -> RAudioProcessor -> ShowS
$cshowsPrec :: Int -> RAudioProcessor -> ShowS
Show, RAudioProcessor -> Ptr RAudioProcessor -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: RAudioProcessor -> Ptr RAudioProcessor -> IO ()
$crlFree :: RAudioProcessor -> Ptr RAudioProcessor -> IO ()
rlFreeDependents :: RAudioProcessor -> Ptr RAudioProcessor -> IO ()
$crlFreeDependents :: RAudioProcessor -> Ptr RAudioProcessor -> IO ()
Freeable)

instance Storable RAudioProcessor where
  sizeOf :: RAudioProcessor -> Int
sizeOf RAudioProcessor
_ = Int
24
  alignment :: RAudioProcessor -> Int
alignment RAudioProcessor
_ = Int
8
  peek :: Ptr RAudioProcessor -> IO RAudioProcessor
peek Ptr RAudioProcessor
_p = do
    Maybe AudioCallback
process <- forall {b} {a}. Ptr b -> IO (Maybe (FunPtr a))
loadProcess Ptr RAudioProcessor
_p
    Ptr Any
nextPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RAudioProcessor
_p Int
8
    Maybe RAudioProcessor
next <- forall {b}. Ptr b -> IO (Maybe RAudioProcessor)
loadNext Ptr Any
nextPtr
    Ptr Any
prevPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RAudioProcessor
_p Int
16
    Maybe RAudioProcessor
prev <- forall {b}. Ptr b -> IO (Maybe RAudioProcessor)
loadPrev Ptr Any
prevPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ let p :: RAudioProcessor
p = Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RAudioProcessor Maybe AudioCallback
process ((\RAudioProcessor
a -> RAudioProcessor
a {rAudioProcessor'prev :: Maybe RAudioProcessor
rAudioProcessor'prev = forall a. a -> Maybe a
Just RAudioProcessor
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor
next) ((\RAudioProcessor
a -> RAudioProcessor
a {rAudioProcessor'next :: Maybe RAudioProcessor
rAudioProcessor'next = forall a. a -> Maybe a
Just RAudioProcessor
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor
prev) in RAudioProcessor
p
    where
      loadProcess :: Ptr b -> IO (Maybe (FunPtr a))
loadProcess Ptr b
ptr = do
        FunPtr a
funPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
        if FunPtr a
funPtr forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FunPtr a
funPtr)
      loadNext :: Ptr b -> IO (Maybe RAudioProcessor)
loadNext Ptr b
ptr =
        if Ptr b
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else do
            Maybe AudioCallback
process <- forall {b} {a}. Ptr b -> IO (Maybe (FunPtr a))
loadProcess Ptr b
ptr
            Ptr b
nextPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
8
            Maybe RAudioProcessor
next <- Ptr b -> IO (Maybe RAudioProcessor)
loadNext Ptr b
nextPtr
            let p :: RAudioProcessor
p = Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RAudioProcessor Maybe AudioCallback
process ((\RAudioProcessor
a -> RAudioProcessor
a {rAudioProcessor'prev :: Maybe RAudioProcessor
rAudioProcessor'prev = forall a. a -> Maybe a
Just RAudioProcessor
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor
next) forall a. Maybe a
Nothing
             in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just RAudioProcessor
p)

      loadPrev :: Ptr b -> IO (Maybe RAudioProcessor)
loadPrev Ptr b
ptr =
        if Ptr b
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          else do
            Maybe AudioCallback
process <- forall {b} {a}. Ptr b -> IO (Maybe (FunPtr a))
loadProcess Ptr b
ptr
            Ptr b
prevPtr <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
16
            Maybe RAudioProcessor
prev <- Ptr b -> IO (Maybe RAudioProcessor)
loadPrev Ptr b
prevPtr
            let p :: RAudioProcessor
p = Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RAudioProcessor Maybe AudioCallback
process forall a. Maybe a
Nothing ((\RAudioProcessor
a -> RAudioProcessor
a {rAudioProcessor'next :: Maybe RAudioProcessor
rAudioProcessor'next = forall a. a -> Maybe a
Just RAudioProcessor
p}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor
prev)
             in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just RAudioProcessor
p)
  poke :: Ptr RAudioProcessor -> RAudioProcessor -> IO ()
poke Ptr RAudioProcessor
_p (RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next Maybe RAudioProcessor
prev) = do
    forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff (forall a b. Ptr a -> Ptr b
castPtr Ptr RAudioProcessor
_p) Int
0 Maybe AudioCallback
process
    Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokeNext (forall a b. Ptr a -> Ptr b
castPtr Ptr RAudioProcessor
_p) Maybe RAudioProcessor
next
    Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokePrev (forall a b. Ptr a -> Ptr b
castPtr Ptr RAudioProcessor
_p) Maybe RAudioProcessor
prev
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      pokeNext :: Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokeNext Ptr (Ptr AudioCallback)
basePtr Maybe RAudioProcessor
pNext =
        case Maybe RAudioProcessor
pNext of
          Maybe RAudioProcessor
Nothing -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
basePtr Int
8 forall a. Ptr a
nullPtr
          Just RAudioProcessor
val -> do
            Ptr (Ptr AudioCallback)
nextPtr <- forall a. Storable a => IO (Ptr a)
malloc
            forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff Ptr (Ptr AudioCallback)
nextPtr Int
0 (RAudioProcessor -> Maybe AudioCallback
rAudioProcessor'process RAudioProcessor
val)
            Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokeNext Ptr (Ptr AudioCallback)
nextPtr (RAudioProcessor -> Maybe RAudioProcessor
rAudioProcessor'next RAudioProcessor
val)
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
nextPtr Int
16 Ptr (Ptr AudioCallback)
basePtr
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
basePtr Int
8 Ptr (Ptr AudioCallback)
nextPtr
      pokePrev :: Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokePrev Ptr (Ptr AudioCallback)
basePtr Maybe RAudioProcessor
pPrev =
        case Maybe RAudioProcessor
pPrev of
          Maybe RAudioProcessor
Nothing -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
basePtr Int
16 forall a. Ptr a
nullPtr
          Just RAudioProcessor
val -> do
            Ptr (Ptr AudioCallback)
prevPtr <- forall a. Storable a => IO (Ptr a)
malloc
            forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff Ptr (Ptr AudioCallback)
prevPtr Int
0 (RAudioProcessor -> Maybe AudioCallback
rAudioProcessor'process RAudioProcessor
val)
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
prevPtr Int
8 Ptr (Ptr AudioCallback)
basePtr
            Ptr (Ptr AudioCallback) -> Maybe RAudioProcessor -> IO ()
pokePrev Ptr (Ptr AudioCallback)
prevPtr (RAudioProcessor -> Maybe RAudioProcessor
rAudioProcessor'prev RAudioProcessor
val)
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Ptr AudioCallback)
basePtr Int
16 Ptr (Ptr AudioCallback)
prevPtr

data AudioStream = AudioStream
  { AudioStream -> Ptr RAudioBuffer
audioStream'buffer :: Ptr RAudioBuffer,
    AudioStream -> Ptr RAudioProcessor
audioStream'processor :: Ptr RAudioProcessor,
    AudioStream -> Integer
audioStream'sampleRate :: Integer,
    AudioStream -> Integer
audioStream'sampleSize :: Integer,
    AudioStream -> Integer
audiostream'channels :: Integer
  }
  deriving (AudioStream -> AudioStream -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioStream -> AudioStream -> Bool
$c/= :: AudioStream -> AudioStream -> Bool
== :: AudioStream -> AudioStream -> Bool
$c== :: AudioStream -> AudioStream -> Bool
Eq, Int -> AudioStream -> ShowS
[AudioStream] -> ShowS
AudioStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioStream] -> ShowS
$cshowList :: [AudioStream] -> ShowS
show :: AudioStream -> String
$cshow :: AudioStream -> String
showsPrec :: Int -> AudioStream -> ShowS
$cshowsPrec :: Int -> AudioStream -> ShowS
Show, AudioStream -> Ptr AudioStream -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: AudioStream -> Ptr AudioStream -> IO ()
$crlFree :: AudioStream -> Ptr AudioStream -> IO ()
rlFreeDependents :: AudioStream -> Ptr AudioStream -> IO ()
$crlFreeDependents :: AudioStream -> Ptr AudioStream -> IO ()
Freeable)

instance Storable AudioStream where
  sizeOf :: AudioStream -> Int
sizeOf AudioStream
_ = Int
32
  alignment :: AudioStream -> Int
alignment AudioStream
_ = Int
8
  peek :: Ptr AudioStream -> IO AudioStream
peek Ptr AudioStream
_p = do
    Ptr RAudioBuffer
buffer <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AudioStream
_p Int
0
    Ptr RAudioProcessor
processor <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AudioStream
_p Int
8
    Integer
sampleRate <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AudioStream
_p Int
16 :: IO CUInt)
    Integer
sampleSize <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AudioStream
_p Int
20 :: IO CUInt)
    Integer
channels <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AudioStream
_p Int
24 :: IO CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels
  poke :: Ptr AudioStream -> AudioStream -> IO ()
poke Ptr AudioStream
_p (AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AudioStream
_p Int
0 Ptr RAudioBuffer
buffer
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AudioStream
_p Int
8 Ptr RAudioProcessor
processor
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AudioStream
_p Int
16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleRate :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AudioStream
_p Int
20 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sampleSize :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AudioStream
_p Int
24 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
channels :: CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Sound = Sound
  { Sound -> AudioStream
sound'stream :: AudioStream,
    Sound -> Integer
sound'frameCount :: Integer
  }
  deriving (Sound -> Sound -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sound -> Sound -> Bool
$c/= :: Sound -> Sound -> Bool
== :: Sound -> Sound -> Bool
$c== :: Sound -> Sound -> Bool
Eq, Int -> Sound -> ShowS
[Sound] -> ShowS
Sound -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sound] -> ShowS
$cshowList :: [Sound] -> ShowS
show :: Sound -> String
$cshow :: Sound -> String
showsPrec :: Int -> Sound -> ShowS
$cshowsPrec :: Int -> Sound -> ShowS
Show, Sound -> Ptr Sound -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Sound -> Ptr Sound -> IO ()
$crlFree :: Sound -> Ptr Sound -> IO ()
rlFreeDependents :: Sound -> Ptr Sound -> IO ()
$crlFreeDependents :: Sound -> Ptr Sound -> IO ()
Freeable)

instance Storable Sound where
  sizeOf :: Sound -> Int
sizeOf Sound
_ = Int
40
  alignment :: Sound -> Int
alignment Sound
_ = Int
8
  peek :: Ptr Sound -> IO Sound
peek Ptr Sound
_p = do
    AudioStream
stream <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Sound
_p Int
0
    Integer
frameCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Sound
_p Int
32 :: IO CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AudioStream -> Integer -> Sound
Sound AudioStream
stream Integer
frameCount
  poke :: Ptr Sound -> Sound -> IO ()
poke Ptr Sound
_p (Sound AudioStream
stream Integer
frameCount) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Sound
_p Int
0 AudioStream
stream
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Sound
_p Int
32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frameCount :: CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Music = Music
  { Music -> AudioStream
music'stream :: AudioStream,
    Music -> Integer
music'frameCount :: Integer,
    Music -> Bool
music'looping :: Bool,
    Music -> MusicContextType
music'ctxType :: MusicContextType,
    Music -> Ptr ()
music'ctxData :: Ptr ()
  }
  deriving (Music -> Music -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Music -> Music -> Bool
$c/= :: Music -> Music -> Bool
== :: Music -> Music -> Bool
$c== :: Music -> Music -> Bool
Eq, Int -> Music -> ShowS
[Music] -> ShowS
Music -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Music] -> ShowS
$cshowList :: [Music] -> ShowS
show :: Music -> String
$cshow :: Music -> String
showsPrec :: Int -> Music -> ShowS
$cshowsPrec :: Int -> Music -> ShowS
Show, Music -> Ptr Music -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: Music -> Ptr Music -> IO ()
$crlFree :: Music -> Ptr Music -> IO ()
rlFreeDependents :: Music -> Ptr Music -> IO ()
$crlFreeDependents :: Music -> Ptr Music -> IO ()
Freeable)

instance Storable Music where
  sizeOf :: Music -> Int
sizeOf Music
_ = Int
56
  alignment :: Music -> Int
alignment Music
_ = Int
4
  peek :: Ptr Music -> IO Music
peek Ptr Music
_p = do
    AudioStream
stream <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Music
_p Int
0
    Integer
frameCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Music
_p Int
32 :: IO CUInt)
    Bool
looping <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Music
_p Int
36 :: IO CBool)
    MusicContextType
ctxType <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Music
_p Int
40
    Ptr ()
ctxData <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Music
_p Int
48
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData
  poke :: Ptr Music -> Music -> IO ()
poke Ptr Music
_p (Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Music
_p Int
0 AudioStream
stream
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Music
_p Int
32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frameCount :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Music
_p Int
36 (forall a. Num a => Bool -> a
fromBool Bool
looping :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Music
_p Int
40 MusicContextType
ctxType
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Music
_p Int
48 Ptr ()
ctxData
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data VrDeviceInfo = VrDeviceInfo
  { VrDeviceInfo -> Int
vrDeviceInfo'hResolution :: Int,
    VrDeviceInfo -> Int
vrDeviceInfo'vResolution :: Int,
    VrDeviceInfo -> Float
vrDeviceInfo'hScreenSize :: Float,
    VrDeviceInfo -> Float
vrDeviceInfo'vScreenSize :: Float,
    VrDeviceInfo -> Float
vrDeviceInfo'vScreenCenter :: Float,
    VrDeviceInfo -> Float
vrDeviceInfo'eyeToScreenDistance :: Float,
    VrDeviceInfo -> Float
vrDeviceInfo'lensSeparationDistance :: Float,
    VrDeviceInfo -> Float
vrDeviceInfo'interpupillaryDistance :: Float,
    VrDeviceInfo -> [Float]
vrDeviceInfo'lensDistortionValues :: [Float],
    VrDeviceInfo -> [Float]
vrDeviceInfo'chromaAbCorrection :: [Float]
  }
  deriving (VrDeviceInfo -> VrDeviceInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VrDeviceInfo -> VrDeviceInfo -> Bool
$c/= :: VrDeviceInfo -> VrDeviceInfo -> Bool
== :: VrDeviceInfo -> VrDeviceInfo -> Bool
$c== :: VrDeviceInfo -> VrDeviceInfo -> Bool
Eq, Int -> VrDeviceInfo -> ShowS
[VrDeviceInfo] -> ShowS
VrDeviceInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VrDeviceInfo] -> ShowS
$cshowList :: [VrDeviceInfo] -> ShowS
show :: VrDeviceInfo -> String
$cshow :: VrDeviceInfo -> String
showsPrec :: Int -> VrDeviceInfo -> ShowS
$cshowsPrec :: Int -> VrDeviceInfo -> ShowS
Show, VrDeviceInfo -> Ptr VrDeviceInfo -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: VrDeviceInfo -> Ptr VrDeviceInfo -> IO ()
$crlFree :: VrDeviceInfo -> Ptr VrDeviceInfo -> IO ()
rlFreeDependents :: VrDeviceInfo -> Ptr VrDeviceInfo -> IO ()
$crlFreeDependents :: VrDeviceInfo -> Ptr VrDeviceInfo -> IO ()
Freeable)

instance Storable VrDeviceInfo where
  sizeOf :: VrDeviceInfo -> Int
sizeOf VrDeviceInfo
_ = Int
64
  alignment :: VrDeviceInfo -> Int
alignment VrDeviceInfo
_ = Int
4
  peek :: Ptr VrDeviceInfo -> IO VrDeviceInfo
peek Ptr VrDeviceInfo
_p = do
    Int
hResolution <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
0 :: IO CInt)
    Int
vResolution <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
4 :: IO CInt)
    Float
hScreenSize <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
8 :: IO CFloat)
    Float
vScreenSize <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
12 :: IO CFloat)
    Float
vScreenCenter <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
16 :: IO CFloat)
    Float
eyeToScreenDistance <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
20 :: IO CFloat)
    Float
lensSeparationDistance <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
24 :: IO CFloat)
    Float
interpupillaryDistance <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VrDeviceInfo
_p Int
28 :: IO CFloat)
    [Float]
lensDistortionValues <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
4 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrDeviceInfo
_p) Int
32 :: IO [CFloat])
    [Float]
chromaAbCorrection <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
4 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrDeviceInfo
_p) Int
48 :: IO [CFloat])
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> [Float]
-> [Float]
-> VrDeviceInfo
VrDeviceInfo Int
hResolution Int
vResolution Float
hScreenSize Float
vScreenSize Float
vScreenCenter Float
eyeToScreenDistance Float
lensSeparationDistance Float
interpupillaryDistance [Float]
lensDistortionValues [Float]
chromaAbCorrection
  poke :: Ptr VrDeviceInfo -> VrDeviceInfo -> IO ()
poke Ptr VrDeviceInfo
_p (VrDeviceInfo Int
hResolution Int
vResolution Float
hScreenSize Float
vScreenSize Float
vScreenCenter Float
eyeToScreenDistance Float
lensSeparationDistance Float
interpupillaryDistance [Float]
lensDistortionValues [Float]
chromaAbCorrection) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hResolution :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vResolution :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
8 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
hScreenSize :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
12 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
vScreenSize :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
16 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
vScreenCenter :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
20 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
eyeToScreenDistance :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
24 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
lensSeparationDistance :: CFloat)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VrDeviceInfo
_p Int
28 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
interpupillaryDistance :: CFloat)
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrDeviceInfo
_p) Int
32 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
lensDistortionValues :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrDeviceInfo
_p) Int
48 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
chromaAbCorrection :: [CFloat])
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data VrStereoConfig = VrStereoConfig
  { VrStereoConfig -> [Matrix]
vrStereoConfig'projection :: [Matrix],
    VrStereoConfig -> [Matrix]
vrStereoConfig'viewOffset :: [Matrix],
    VrStereoConfig -> [Float]
vrStereoConfig'leftLensCenter :: [Float],
    VrStereoConfig -> [Float]
vrStereoConfig'rightLensCenter :: [Float],
    VrStereoConfig -> [Float]
vrStereoConfig'leftScreenCenter :: [Float],
    VrStereoConfig -> [Float]
vrStereoConfig'rightScreenCenter :: [Float],
    VrStereoConfig -> [Float]
vrStereoConfig'scale :: [Float],
    VrStereoConfig -> [Float]
vrStereoConfig'scaleIn :: [Float]
  }
  deriving (VrStereoConfig -> VrStereoConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VrStereoConfig -> VrStereoConfig -> Bool
$c/= :: VrStereoConfig -> VrStereoConfig -> Bool
== :: VrStereoConfig -> VrStereoConfig -> Bool
$c== :: VrStereoConfig -> VrStereoConfig -> Bool
Eq, Int -> VrStereoConfig -> ShowS
[VrStereoConfig] -> ShowS
VrStereoConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VrStereoConfig] -> ShowS
$cshowList :: [VrStereoConfig] -> ShowS
show :: VrStereoConfig -> String
$cshow :: VrStereoConfig -> String
showsPrec :: Int -> VrStereoConfig -> ShowS
$cshowsPrec :: Int -> VrStereoConfig -> ShowS
Show, VrStereoConfig -> Ptr VrStereoConfig -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: VrStereoConfig -> Ptr VrStereoConfig -> IO ()
$crlFree :: VrStereoConfig -> Ptr VrStereoConfig -> IO ()
rlFreeDependents :: VrStereoConfig -> Ptr VrStereoConfig -> IO ()
$crlFreeDependents :: VrStereoConfig -> Ptr VrStereoConfig -> IO ()
Freeable)

instance Storable VrStereoConfig where
  sizeOf :: VrStereoConfig -> Int
sizeOf VrStereoConfig
_ = Int
304
  alignment :: VrStereoConfig -> Int
alignment VrStereoConfig
_ = Int
4
  peek :: Ptr VrStereoConfig -> IO VrStereoConfig
peek Ptr VrStereoConfig
_p = do
    [Matrix]
projection <- forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
0
    [Matrix]
viewOffset <- forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
128
    [Float]
leftLensCenter <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
256 :: IO [CFloat])
    [Float]
rightLensCenter <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
264 :: IO [CFloat])
    [Float]
leftScreenCenter <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
272 :: IO [CFloat])
    [Float]
rightScreenCenter <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
280 :: IO [CFloat])
    [Float]
scale <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
288 :: IO [CFloat])
    [Float]
scaleIn <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
2 (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
296 :: IO [CFloat])
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Matrix]
-> [Matrix]
-> [Float]
-> [Float]
-> [Float]
-> [Float]
-> [Float]
-> [Float]
-> VrStereoConfig
VrStereoConfig [Matrix]
projection [Matrix]
viewOffset [Float]
leftLensCenter [Float]
rightLensCenter [Float]
leftScreenCenter [Float]
rightScreenCenter [Float]
scale [Float]
scaleIn
  poke :: Ptr VrStereoConfig -> VrStereoConfig -> IO ()
poke Ptr VrStereoConfig
_p (VrStereoConfig [Matrix]
projection [Matrix]
viewOffset [Float]
leftLensCenter [Float]
rightLensCenter [Float]
leftScreenCenter [Float]
rightScreenCenter [Float]
scale [Float]
scaleIn) = do
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
0 [Matrix]
projection
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
128 [Matrix]
viewOffset
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
256 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
leftLensCenter :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
264 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
rightLensCenter :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
272 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
leftScreenCenter :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
280 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
rightScreenCenter :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
288 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
scale :: [CFloat])
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr VrStereoConfig
_p) Int
296 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Real a, Fractional b) => a -> b
realToFrac [Float]
scaleIn :: [CFloat])
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data FilePathList = FilePathList
  { FilePathList -> Integer
filePathlist'capacity :: Integer,
    FilePathList -> [String]
filePathList'paths :: [String]
  }
  deriving (FilePathList -> FilePathList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathList -> FilePathList -> Bool
$c/= :: FilePathList -> FilePathList -> Bool
== :: FilePathList -> FilePathList -> Bool
$c== :: FilePathList -> FilePathList -> Bool
Eq, Int -> FilePathList -> ShowS
[FilePathList] -> ShowS
FilePathList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathList] -> ShowS
$cshowList :: [FilePathList] -> ShowS
show :: FilePathList -> String
$cshow :: FilePathList -> String
showsPrec :: Int -> FilePathList -> ShowS
$cshowsPrec :: Int -> FilePathList -> ShowS
Show)

instance Storable FilePathList where
  sizeOf :: FilePathList -> Int
sizeOf FilePathList
_ = Int
16
  alignment :: FilePathList -> Int
alignment FilePathList
_ = Int
4
  peek :: Ptr FilePathList -> IO FilePathList
peek Ptr FilePathList
_p = do
    Integer
capacity <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FilePathList
_p Int
0 :: IO CUInt)
    Int
count <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FilePathList
_p Int
4 :: IO CUInt)
    Ptr CString
pathsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FilePathList
_p Int
8 :: IO (Ptr CString))
    [CString]
pathsCStrings <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr CString
pathsPtr
    [String]
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CString -> IO String
peekCString [CString]
pathsCStrings
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> [String] -> FilePathList
FilePathList Integer
capacity [String]
paths
  poke :: Ptr FilePathList -> FilePathList -> IO ()
poke Ptr FilePathList
_p (FilePathList Integer
capacity [String]
paths) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FilePathList
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
capacity :: CUInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FilePathList
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
paths) :: CUInt)
    [CString]
pathsCStrings <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO CString
newCString [String]
paths
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FilePathList
_p Int
8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [CString]
pathsCStrings
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable FilePathList where
  rlFreeDependents :: FilePathList -> Ptr FilePathList -> IO ()
rlFreeDependents FilePathList
val Ptr FilePathList
ptr = do
    Ptr CString
pathsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FilePathList
ptr Int
8 :: IO (Ptr CString))
    [CString]
pathsCStrings <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ FilePathList -> [String]
filePathList'paths FilePathList
val) Ptr CString
pathsPtr
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr () -> IO ()
c'free forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr) [CString]
pathsCStrings
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CString
pathsPtr

---- rlgl.h


-- | Dynamic vertex buffers (position + texcoords + colors + indices arrays)

data RLVertexBuffer = RLVertexBuffer
  { -- | Number of elements in the buffer (QUADS)

    RLVertexBuffer -> Int
rlVertexBuffer'elementCount :: Int,
    -- | Vertex position (shader-location = 0)

    RLVertexBuffer -> [Vector3]
rlVertexBuffer'vertices :: [Vector3],
    -- | Vertex texture coordinates (UV - 2 components per vertex) (shader-location = 1)

    RLVertexBuffer -> [Vector2]
rlVertexBuffer'texcoords :: [Vector2],
    -- | Vertex colors (RGBA - 4 components per vertex) (shader-location = 3)

    RLVertexBuffer -> [Color]
rlVertexBuffer'colors :: [Color],
    -- | Vertex indices (in case vertex data comes indexed) (6 indices per quad)

    RLVertexBuffer -> [Integer]
rlVertexBuffer'indices :: [Integer],
    -- | OpenGL Vertex Array Object id

    RLVertexBuffer -> Integer
rlVertexBuffer'vaoId :: Integer,
    -- | OpenGL Vertex Buffer Objects id (4 types of vertex data)

    RLVertexBuffer -> [Integer]
rlVertexBuffer'vboId :: [Integer]
  }
  deriving (RLVertexBuffer -> RLVertexBuffer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLVertexBuffer -> RLVertexBuffer -> Bool
$c/= :: RLVertexBuffer -> RLVertexBuffer -> Bool
== :: RLVertexBuffer -> RLVertexBuffer -> Bool
$c== :: RLVertexBuffer -> RLVertexBuffer -> Bool
Eq, Int -> RLVertexBuffer -> ShowS
[RLVertexBuffer] -> ShowS
RLVertexBuffer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLVertexBuffer] -> ShowS
$cshowList :: [RLVertexBuffer] -> ShowS
show :: RLVertexBuffer -> String
$cshow :: RLVertexBuffer -> String
showsPrec :: Int -> RLVertexBuffer -> ShowS
$cshowsPrec :: Int -> RLVertexBuffer -> ShowS
Show)

instance Storable RLVertexBuffer where
  sizeOf :: RLVertexBuffer -> Int
sizeOf RLVertexBuffer
_ = Int
64
  alignment :: RLVertexBuffer -> Int
alignment RLVertexBuffer
_ = Int
8
  peek :: Ptr RLVertexBuffer -> IO RLVertexBuffer
peek Ptr RLVertexBuffer
_p = do
    Int
elementCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
0 :: IO CInt)
    Ptr Vector3
verticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
8 :: IO (Ptr Vector3))
    [Vector3]
vertices <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
elementCount Ptr Vector3
verticesPtr
    Ptr Vector2
texcoordsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
16 :: IO (Ptr Vector2))
    [Vector2]
texcoords <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
elementCount Ptr Vector2
texcoordsPtr
    Ptr Color
colorsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
24 :: IO (Ptr Color))
    [Color]
colors <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
elementCount Ptr Color
colorsPtr
    Ptr CUInt
indicesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
32 :: IO (Ptr CUInt))
    [Integer]
indices <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
elementCount Ptr CUInt
indicesPtr
    Integer
vaoId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
_p Int
40 :: IO CUInt)
    [Integer]
vboId <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
4 (forall a b. Ptr a -> Ptr b
castPtr Ptr RLVertexBuffer
_p :: Ptr CUInt) Int
44
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
-> [Vector3]
-> [Vector2]
-> [Color]
-> [Integer]
-> Integer
-> [Integer]
-> RLVertexBuffer
RLVertexBuffer Int
elementCount [Vector3]
vertices [Vector2]
texcoords [Color]
colors [Integer]
indices Integer
vaoId [Integer]
vboId
  poke :: Ptr RLVertexBuffer -> RLVertexBuffer -> IO ()
poke Ptr RLVertexBuffer
_p (RLVertexBuffer Int
elementCount [Vector3]
vertices [Vector2]
texcoords [Color]
colors [Integer]
indices Integer
vaoId [Integer]
vboId) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elementCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Vector3]
vertices
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
16 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Vector2]
texcoords
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
24 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [Color]
colors
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
32 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
indices :: [CUInt])
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLVertexBuffer
_p Int
40 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vaoId :: CUInt)
    forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff (forall a b. Ptr a -> Ptr b
castPtr Ptr RLVertexBuffer
_p) Int
44 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
vboId :: [CUInt])
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable RLVertexBuffer where
  rlFreeDependents :: RLVertexBuffer -> Ptr RLVertexBuffer -> IO ()
rlFreeDependents RLVertexBuffer
_ Ptr RLVertexBuffer
ptr = do
    Ptr Vector3
verticesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
ptr Int
8 :: IO (Ptr Vector3))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector3
verticesPtr
    Ptr Vector2
texcoordsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
ptr Int
16 :: IO (Ptr Vector2))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Vector2
texcoordsPtr
    Ptr Color
colorsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
ptr Int
24 :: IO (Ptr Color))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Color
colorsPtr
    Ptr CUInt
indicesPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLVertexBuffer
ptr Int
32 :: IO (Ptr CUInt))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CUInt
indicesPtr

-- | Draw call type.

-- NOTE: Only texture changes register a new draw, other state-change-related elements are not

-- used at this moment (vaoId, shaderId, matrices), raylib just forces a batch draw call if any

-- of those state changes happen (this is done in the core module).

data RLDrawCall = RLDrawCall
  { -- | Drawing mode: LINES, TRIANGLES, QUADS

    RLDrawCall -> RLDrawMode
rlDrawCall'mode :: RLDrawMode,
    -- | Number of vertices of the draw

    RLDrawCall -> Int
rlDrawCall'vertexCount :: Int,
    -- | Number of vertices required for index alignment (LINES, TRIANGLES)

    RLDrawCall -> Int
rlDrawCall'vertexAlignment :: Int,
    -- | Texture id to be used on the draw -> Used to create new draw call if changed

    RLDrawCall -> Integer
rlDrawCall'textureId :: Integer
  }
  deriving (RLDrawCall -> RLDrawCall -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLDrawCall -> RLDrawCall -> Bool
$c/= :: RLDrawCall -> RLDrawCall -> Bool
== :: RLDrawCall -> RLDrawCall -> Bool
$c== :: RLDrawCall -> RLDrawCall -> Bool
Eq, Int -> RLDrawCall -> ShowS
[RLDrawCall] -> ShowS
RLDrawCall -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLDrawCall] -> ShowS
$cshowList :: [RLDrawCall] -> ShowS
show :: RLDrawCall -> String
$cshow :: RLDrawCall -> String
showsPrec :: Int -> RLDrawCall -> ShowS
$cshowsPrec :: Int -> RLDrawCall -> ShowS
Show, RLDrawCall -> Ptr RLDrawCall -> IO ()
forall a.
(a -> Ptr a -> IO ()) -> (a -> Ptr a -> IO ()) -> Freeable a
rlFree :: RLDrawCall -> Ptr RLDrawCall -> IO ()
$crlFree :: RLDrawCall -> Ptr RLDrawCall -> IO ()
rlFreeDependents :: RLDrawCall -> Ptr RLDrawCall -> IO ()
$crlFreeDependents :: RLDrawCall -> Ptr RLDrawCall -> IO ()
Freeable)

instance Storable RLDrawCall where
  sizeOf :: RLDrawCall -> Int
sizeOf RLDrawCall
_ = Int
16
  alignment :: RLDrawCall -> Int
alignment RLDrawCall
_ = Int
8
  peek :: Ptr RLDrawCall -> IO RLDrawCall
peek Ptr RLDrawCall
_p = do
    RLDrawMode
mode <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLDrawCall
_p Int
0
    Int
vertexCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLDrawCall
_p Int
4 :: IO CInt)
    Int
vertexAlignment <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLDrawCall
_p Int
8 :: IO CInt)
    Integer
textureId <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLDrawCall
_p Int
12 :: IO CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RLDrawMode -> Int -> Int -> Integer -> RLDrawCall
RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId
  poke :: Ptr RLDrawCall -> RLDrawCall -> IO ()
poke Ptr RLDrawCall
_p (RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLDrawCall
_p Int
0 RLDrawMode
mode
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLDrawCall
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vertexCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLDrawCall
_p Int
8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vertexAlignment :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLDrawCall
_p Int
12 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
textureId :: CUInt)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- rlRenderBatch type

data RLRenderBatch = RLRenderBatch
  { -- | Number of vertex buffers (multi-buffering support)

    RLRenderBatch -> Int
rlRenderBatch'bufferCount :: Int,
    -- | Current buffer tracking in case of multi-buffering

    RLRenderBatch -> Int
rlRenderBatch'currentBuffer :: Int,
    -- | Dynamic buffer(s) for vertex data

    RLRenderBatch -> [RLVertexBuffer]
rlRenderBatch'vertexBuffers :: [RLVertexBuffer],
    -- | Draw calls array, depends on textureId

    RLRenderBatch -> [RLDrawCall]
rlRenderBatch'draws :: [RLDrawCall],
    -- | Draw calls counter

    RLRenderBatch -> Int
rlRenderBatch'drawCounter :: Int,
    -- | Current depth value for next draw

    RLRenderBatch -> Float
rlRenderBatch'currentDepth :: Float
  }
  deriving (RLRenderBatch -> RLRenderBatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLRenderBatch -> RLRenderBatch -> Bool
$c/= :: RLRenderBatch -> RLRenderBatch -> Bool
== :: RLRenderBatch -> RLRenderBatch -> Bool
$c== :: RLRenderBatch -> RLRenderBatch -> Bool
Eq, Int -> RLRenderBatch -> ShowS
[RLRenderBatch] -> ShowS
RLRenderBatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RLRenderBatch] -> ShowS
$cshowList :: [RLRenderBatch] -> ShowS
show :: RLRenderBatch -> String
$cshow :: RLRenderBatch -> String
showsPrec :: Int -> RLRenderBatch -> ShowS
$cshowsPrec :: Int -> RLRenderBatch -> ShowS
Show)

instance Storable RLRenderBatch where
  sizeOf :: RLRenderBatch -> Int
sizeOf RLRenderBatch
_ = Int
32
  alignment :: RLRenderBatch -> Int
alignment RLRenderBatch
_ = Int
8
  peek :: Ptr RLRenderBatch -> IO RLRenderBatch
peek Ptr RLRenderBatch
_p = do
    Int
bufferCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
0 :: IO CInt)
    Int
currentBuffer <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
4 :: IO CInt)
    Ptr RLVertexBuffer
vertexBuffersPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
8 :: IO (Ptr RLVertexBuffer))
    [RLVertexBuffer]
vertexBuffers <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
bufferCount Ptr RLVertexBuffer
vertexBuffersPtr
    Ptr RLDrawCall
drawsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
16 :: IO (Ptr RLDrawCall))
    [RLDrawCall]
draws <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
256 Ptr RLDrawCall
drawsPtr
    Int
drawCounter <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
24 :: IO CInt)
    Float
currentDepth <- forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
_p Int
28 :: IO CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth
  poke :: Ptr RLRenderBatch -> RLRenderBatch -> IO ()
poke Ptr RLRenderBatch
_p (RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferCount :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentBuffer :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [RLVertexBuffer]
vertexBuffers
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
16 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => [a] -> IO (Ptr a)
newArray [RLDrawCall]
draws
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
24 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
drawCounter :: CInt)
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr RLRenderBatch
_p Int
28 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
currentDepth :: CFloat)
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Freeable RLRenderBatch where
  rlFreeDependents :: RLRenderBatch -> Ptr RLRenderBatch -> IO ()
rlFreeDependents RLRenderBatch
val Ptr RLRenderBatch
ptr = do
    Ptr RLVertexBuffer
vertexBuffersPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
ptr Int
8 :: IO (Ptr RLVertexBuffer))
    forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray (RLRenderBatch -> [RLVertexBuffer]
rlRenderBatch'vertexBuffers RLRenderBatch
val) Ptr RLVertexBuffer
vertexBuffersPtr
    Ptr RLDrawCall
drawsPtr <- (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr RLRenderBatch
ptr Int
16 :: IO (Ptr RLDrawCall))
    Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr RLDrawCall
drawsPtr

------------------------------------------------

-- Raylib callbacks ----------------------------

------------------------------------------------


type LoadFileDataCallback = FunPtr (CString -> Ptr CUInt -> IO (Ptr CUChar))

type SaveFileDataCallback = FunPtr (CString -> Ptr () -> CUInt -> IO CInt)

type LoadFileTextCallback = FunPtr (CString -> IO CString)

type SaveFileTextCallback = FunPtr (CString -> CString -> IO CInt)

type AudioCallback = FunPtr (Ptr () -> CUInt -> IO ())