{-# OPTIONS -Wall #-}

module Raylib.Util.Lenses where

import Control.Lens (Lens')
import Data.Word (Word8, Word16)
import Foreign.Ptr (Ptr)
import qualified Raylib.Types as RL



_vector2'x :: Lens' RL.Vector2 Float
_vector2'x :: Lens' Vector2 Float
_vector2'x Float -> f Float
f (RL.Vector2 Float
x Float
y) = (\Float
x' -> Float -> Float -> Vector2
RL.Vector2 Float
x' Float
y) (Float -> Vector2) -> f Float -> f Vector2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
x
{-# INLINE _vector2'x #-}
_vector2'y :: Lens' RL.Vector2 Float
_vector2'y :: Lens' Vector2 Float
_vector2'y Float -> f Float
f (RL.Vector2 Float
x Float
y) = (\Float
y' -> Float -> Float -> Vector2
RL.Vector2 Float
x Float
y') (Float -> Vector2) -> f Float -> f Vector2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
y
{-# INLINE _vector2'y #-}


_vector3'x :: Lens' RL.Vector3 Float
_vector3'x :: Lens' Vector3 Float
_vector3'x Float -> f Float
f (RL.Vector3 Float
x Float
y Float
z) = (\Float
x' -> Float -> Float -> Float -> Vector3
RL.Vector3 Float
x' Float
y Float
z) (Float -> Vector3) -> f Float -> f Vector3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
x
{-# INLINE _vector3'x #-}
_vector3'y :: Lens' RL.Vector3 Float
_vector3'y :: Lens' Vector3 Float
_vector3'y Float -> f Float
f (RL.Vector3 Float
x Float
y Float
z) = (\Float
y' -> Float -> Float -> Float -> Vector3
RL.Vector3 Float
x Float
y' Float
z) (Float -> Vector3) -> f Float -> f Vector3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
y
{-# INLINE _vector3'y #-}
_vector3'z :: Lens' RL.Vector3 Float
_vector3'z :: Lens' Vector3 Float
_vector3'z Float -> f Float
f (RL.Vector3 Float
x Float
y Float
z) = (\Float
z' -> Float -> Float -> Float -> Vector3
RL.Vector3 Float
x Float
y Float
z') (Float -> Vector3) -> f Float -> f Vector3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
z
{-# INLINE _vector3'z #-}

_vector4'x :: Lens' RL.Vector4 Float
_vector4'x :: Lens' Vector4 Float
_vector4'x Float -> f Float
f (RL.Vector4 Float
x Float
y Float
z Float
w) = (\Float
x' -> Float -> Float -> Float -> Float -> Vector4
RL.Vector4 Float
x' Float
y Float
z Float
w) (Float -> Vector4) -> f Float -> f Vector4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
x
{-# INLINE _vector4'x #-}
_vector4'y :: Lens' RL.Vector4 Float
_vector4'y :: Lens' Vector4 Float
_vector4'y Float -> f Float
f (RL.Vector4 Float
x Float
y Float
z Float
w) = (\Float
y' -> Float -> Float -> Float -> Float -> Vector4
RL.Vector4 Float
x Float
y' Float
z Float
w) (Float -> Vector4) -> f Float -> f Vector4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
y
{-# INLINE _vector4'y #-}
_vector4'z :: Lens' RL.Vector4 Float
_vector4'z :: Lens' Vector4 Float
_vector4'z Float -> f Float
f (RL.Vector4 Float
x Float
y Float
z Float
w) = (\Float
z' -> Float -> Float -> Float -> Float -> Vector4
RL.Vector4 Float
x Float
y Float
z' Float
w) (Float -> Vector4) -> f Float -> f Vector4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
z
{-# INLINE _vector4'z #-}
_vector4'w :: Lens' RL.Vector4 Float
_vector4'w :: Lens' Vector4 Float
_vector4'w Float -> f Float
f (RL.Vector4 Float
x Float
y Float
z Float
w) = (\Float
w' -> Float -> Float -> Float -> Float -> Vector4
RL.Vector4 Float
x Float
y Float
z Float
w') (Float -> Vector4) -> f Float -> f Vector4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
w
{-# INLINE _vector4'w #-}


_matrix'm0 :: Lens' RL.Matrix Float
_matrix'm0 :: Lens' Matrix Float
_matrix'm0 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm0 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm0 Matrix
matrix)
{-# INLINE _matrix'm0 #-}
_matrix'm1 :: Lens' RL.Matrix Float
_matrix'm1 :: Lens' Matrix Float
_matrix'm1 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm1 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm1 Matrix
matrix)
{-# INLINE _matrix'm1 #-}
_matrix'm2 :: Lens' RL.Matrix Float
_matrix'm2 :: Lens' Matrix Float
_matrix'm2 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm2 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm2 Matrix
matrix)
{-# INLINE _matrix'm2 #-}
_matrix'm3 :: Lens' RL.Matrix Float
_matrix'm3 :: Lens' Matrix Float
_matrix'm3 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm3 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm3 Matrix
matrix)
{-# INLINE _matrix'm3 #-}
_matrix'm4 :: Lens' RL.Matrix Float
_matrix'm4 :: Lens' Matrix Float
_matrix'm4 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm4 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm4 Matrix
matrix)
{-# INLINE _matrix'm4 #-}
_matrix'm5 :: Lens' RL.Matrix Float
_matrix'm5 :: Lens' Matrix Float
_matrix'm5 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm5 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm5 Matrix
matrix)
{-# INLINE _matrix'm5 #-}
_matrix'm6 :: Lens' RL.Matrix Float
_matrix'm6 :: Lens' Matrix Float
_matrix'm6 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm6 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm6 Matrix
matrix)
{-# INLINE _matrix'm6 #-}
_matrix'm7 :: Lens' RL.Matrix Float
_matrix'm7 :: Lens' Matrix Float
_matrix'm7 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm7 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm7 Matrix
matrix)
{-# INLINE _matrix'm7 #-}
_matrix'm8 :: Lens' RL.Matrix Float
_matrix'm8 :: Lens' Matrix Float
_matrix'm8 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm8 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm8 Matrix
matrix)
{-# INLINE _matrix'm8 #-}
_matrix'm9 :: Lens' RL.Matrix Float
_matrix'm9 :: Lens' Matrix Float
_matrix'm9 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm9 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm9 Matrix
matrix)
{-# INLINE _matrix'm9 #-}
_matrix'm10 :: Lens' RL.Matrix Float
_matrix'm10 :: Lens' Matrix Float
_matrix'm10 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm10 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm10 Matrix
matrix)
{-# INLINE _matrix'm10 #-}
_matrix'm11 :: Lens' RL.Matrix Float
_matrix'm11 :: Lens' Matrix Float
_matrix'm11 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm11 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm11 Matrix
matrix)
{-# INLINE _matrix'm11 #-}
_matrix'm12 :: Lens' RL.Matrix Float
_matrix'm12 :: Lens' Matrix Float
_matrix'm12 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm12 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm12 Matrix
matrix)
{-# INLINE _matrix'm12 #-}
_matrix'm13 :: Lens' RL.Matrix Float
_matrix'm13 :: Lens' Matrix Float
_matrix'm13 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm13 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm13 Matrix
matrix)
{-# INLINE _matrix'm13 #-}
_matrix'm14 :: Lens' RL.Matrix Float
_matrix'm14 :: Lens' Matrix Float
_matrix'm14 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm14 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm14 Matrix
matrix)
{-# INLINE _matrix'm14 #-}
_matrix'm15 :: Lens' RL.Matrix Float
_matrix'm15 :: Lens' Matrix Float
_matrix'm15 Float -> f Float
f Matrix
matrix = (\Float
m' -> Matrix
matrix { RL.matrix'm15 = m' }) (Float -> Matrix) -> f Float -> f Matrix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f (Matrix -> Float
RL.matrix'm15 Matrix
matrix)
{-# INLINE _matrix'm15 #-}


_color'r :: Lens' RL.Color Word8
_color'r :: Lens' Color Word8
_color'r Word8 -> f Word8
f (RL.Color Word8
r Word8
g Word8
b Word8
a) = (\Word8
r' -> Word8 -> Word8 -> Word8 -> Word8 -> Color
RL.Color Word8
r' Word8
g Word8
b Word8
a) (Word8 -> Color) -> f Word8 -> f Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> f Word8
f Word8
r
{-# INLINE _color'r #-}
_color'g :: Lens' RL.Color Word8
_color'g :: Lens' Color Word8
_color'g Word8 -> f Word8
f (RL.Color Word8
r Word8
g Word8
b Word8
a) = (\Word8
g' -> Word8 -> Word8 -> Word8 -> Word8 -> Color
RL.Color Word8
r Word8
g' Word8
b Word8
a) (Word8 -> Color) -> f Word8 -> f Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> f Word8
f Word8
g
{-# INLINE _color'g #-}
_color'b :: Lens' RL.Color Word8
_color'b :: Lens' Color Word8
_color'b Word8 -> f Word8
f (RL.Color Word8
r Word8
g Word8
b Word8
a) = (\Word8
b' -> Word8 -> Word8 -> Word8 -> Word8 -> Color
RL.Color Word8
r Word8
g Word8
b' Word8
a) (Word8 -> Color) -> f Word8 -> f Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> f Word8
f Word8
b
{-# INLINE _color'b #-}
_color'a :: Lens' RL.Color Word8
_color'a :: Lens' Color Word8
_color'a Word8 -> f Word8
f (RL.Color Word8
r Word8
g Word8
b Word8
a) = (\Word8
a' -> Word8 -> Word8 -> Word8 -> Word8 -> Color
RL.Color Word8
r Word8
g Word8
b Word8
a') (Word8 -> Color) -> f Word8 -> f Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> f Word8
f Word8
a
{-# INLINE _color'a #-}


_rectangle'x :: Lens' RL.Rectangle Float
_rectangle'x :: Lens' Rectangle Float
_rectangle'x Float -> f Float
f (RL.Rectangle Float
x Float
y Float
width Float
height) = (\Float
x' -> Float -> Float -> Float -> Float -> Rectangle
RL.Rectangle Float
x' Float
y Float
width Float
height) (Float -> Rectangle) -> f Float -> f Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
x
{-# INLINE _rectangle'x #-}
_rectangle'y :: Lens' RL.Rectangle Float
_rectangle'y :: Lens' Rectangle Float
_rectangle'y Float -> f Float
f (RL.Rectangle Float
x Float
y Float
width Float
height) = (\Float
y' -> Float -> Float -> Float -> Float -> Rectangle
RL.Rectangle Float
x Float
y' Float
width Float
height) (Float -> Rectangle) -> f Float -> f Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
y
{-# INLINE _rectangle'y #-}
_rectangle'width :: Lens' RL.Rectangle Float
_rectangle'width :: Lens' Rectangle Float
_rectangle'width Float -> f Float
f (RL.Rectangle Float
x Float
y Float
width Float
height) = (\Float
width' -> Float -> Float -> Float -> Float -> Rectangle
RL.Rectangle Float
x Float
y Float
width' Float
height) (Float -> Rectangle) -> f Float -> f Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
width
{-# INLINE _rectangle'width #-}
_rectangle'height :: Lens' RL.Rectangle Float
_rectangle'height :: Lens' Rectangle Float
_rectangle'height Float -> f Float
f (RL.Rectangle Float
x Float
y Float
width Float
height) = (\Float
height' -> Float -> Float -> Float -> Float -> Rectangle
RL.Rectangle Float
x Float
y Float
width Float
height') (Float -> Rectangle) -> f Float -> f Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
height
{-# INLINE _rectangle'height #-}


_image'data :: Lens' RL.Image [Word8]
_image'data :: Lens' Image [Word8]
_image'data [Word8] -> f [Word8]
f (RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\[Word8]
imgData' -> [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
RL.Image [Word8]
imgData' Int
width Int
height Int
mipmaps PixelFormat
format) ([Word8] -> Image) -> f [Word8] -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> f [Word8]
f [Word8]
imgData
{-# INLINE _image'data #-}
_image'width :: Lens' RL.Image Int
_image'width :: Lens' Image Int
_image'width Int -> f Int
f (RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
width' -> [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
RL.Image [Word8]
imgData Int
width' Int
height Int
mipmaps PixelFormat
format) (Int -> Image) -> f Int -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
width
{-# INLINE _image'width #-}
_image'height :: Lens' RL.Image Int
_image'height :: Lens' Image Int
_image'height Int -> f Int
f (RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
height' -> [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
RL.Image [Word8]
imgData Int
width Int
height' Int
mipmaps PixelFormat
format) (Int -> Image) -> f Int -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
height
{-# INLINE _image'height #-}
_image'mipmaps :: Lens' RL.Image Int
_image'mipmaps :: Lens' Image Int
_image'mipmaps Int -> f Int
f (RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
mipmaps' -> [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps' PixelFormat
format) (Int -> Image) -> f Int -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
mipmaps
{-# INLINE _image'mipmaps #-}
_image'format :: Lens' RL.Image RL.PixelFormat
_image'format :: Lens' Image PixelFormat
_image'format PixelFormat -> f PixelFormat
f (RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\PixelFormat
format' -> [Word8] -> Int -> Int -> Int -> PixelFormat -> Image
RL.Image [Word8]
imgData Int
width Int
height Int
mipmaps PixelFormat
format') (PixelFormat -> Image) -> f PixelFormat -> f Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PixelFormat -> f PixelFormat
f PixelFormat
format
{-# INLINE _image'format #-}


_texture'id :: Lens' RL.Texture Integer
_texture'id :: Lens' Texture Integer
_texture'id Integer -> f Integer
f (RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Integer
ident' -> Integer -> Int -> Int -> Int -> PixelFormat -> Texture
RL.Texture Integer
ident' Int
width Int
height Int
mipmaps PixelFormat
format) (Integer -> Texture) -> f Integer -> f Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
ident
{-# INLINE _texture'id #-}
_texture'width :: Lens' RL.Texture Int
_texture'width :: Lens' Texture Int
_texture'width Int -> f Int
f (RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
width' -> Integer -> Int -> Int -> Int -> PixelFormat -> Texture
RL.Texture Integer
ident Int
width' Int
height Int
mipmaps PixelFormat
format) (Int -> Texture) -> f Int -> f Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
width
{-# INLINE _texture'width #-}
_texture'height :: Lens' RL.Texture Int
_texture'height :: Lens' Texture Int
_texture'height Int -> f Int
f (RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
height' -> Integer -> Int -> Int -> Int -> PixelFormat -> Texture
RL.Texture Integer
ident Int
width Int
height' Int
mipmaps PixelFormat
format) (Int -> Texture) -> f Int -> f Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
height
{-# INLINE _texture'height #-}
_texture'mipmaps :: Lens' RL.Texture Int
_texture'mipmaps :: Lens' Texture Int
_texture'mipmaps Int -> f Int
f (RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\Int
mipmaps' -> Integer -> Int -> Int -> Int -> PixelFormat -> Texture
RL.Texture Integer
ident Int
width Int
height Int
mipmaps' PixelFormat
format) (Int -> Texture) -> f Int -> f Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
mipmaps
{-# INLINE _texture'mipmaps #-}
_texture'format :: Lens' RL.Texture RL.PixelFormat
_texture'format :: Lens' Texture PixelFormat
_texture'format PixelFormat -> f PixelFormat
f (RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format) =
    (\PixelFormat
format' -> Integer -> Int -> Int -> Int -> PixelFormat -> Texture
RL.Texture Integer
ident Int
width Int
height Int
mipmaps PixelFormat
format') (PixelFormat -> Texture) -> f PixelFormat -> f Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PixelFormat -> f PixelFormat
f PixelFormat
format
{-# INLINE _texture'format #-}


_renderTexture'id :: Lens' RL.RenderTexture Integer
_renderTexture'id :: Lens' RenderTexture Integer
_renderTexture'id Integer -> f Integer
f (RL.RenderTexture Integer
ident Texture
texture Texture
depth) =
    (\Integer
ident' -> Integer -> Texture -> Texture -> RenderTexture
RL.RenderTexture Integer
ident' Texture
texture Texture
depth) (Integer -> RenderTexture) -> f Integer -> f RenderTexture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
ident
{-# INLINE _renderTexture'id #-}
_renderTexture'texture :: Lens' RL.RenderTexture RL.Texture
_renderTexture'texture :: Lens' RenderTexture Texture
_renderTexture'texture Texture -> f Texture
f (RL.RenderTexture Integer
ident Texture
texture Texture
depth) =
    (\Texture
texture' -> Integer -> Texture -> Texture -> RenderTexture
RL.RenderTexture Integer
ident Texture
texture' Texture
depth) (Texture -> RenderTexture) -> f Texture -> f RenderTexture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Texture -> f Texture
f Texture
texture
{-# INLINE _renderTexture'texture #-}
_renderTexture'depth :: Lens' RL.RenderTexture RL.Texture
_renderTexture'depth :: Lens' RenderTexture Texture
_renderTexture'depth Texture -> f Texture
f (RL.RenderTexture Integer
ident Texture
texture Texture
depth) =
    (\Texture
depth' -> Integer -> Texture -> Texture -> RenderTexture
RL.RenderTexture Integer
ident Texture
texture Texture
depth') (Texture -> RenderTexture) -> f Texture -> f RenderTexture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Texture -> f Texture
f Texture
depth
{-# INLINE _renderTexture'depth #-}


_nPatchInfo'source :: Lens' RL.NPatchInfo RL.Rectangle
_nPatchInfo'source :: Lens' NPatchInfo Rectangle
_nPatchInfo'source Rectangle -> f Rectangle
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\Rectangle
source' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source' Int
left Int
top Int
right Int
bottom NPatchLayout
layout) (Rectangle -> NPatchInfo) -> f Rectangle -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> f Rectangle
f Rectangle
source
{-# INLINE _nPatchInfo'source #-}
_nPatchInfo'left :: Lens' RL.NPatchInfo Int
_nPatchInfo'left :: Lens' NPatchInfo Int
_nPatchInfo'left Int -> f Int
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\Int
left' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source Int
left' Int
top Int
right Int
bottom NPatchLayout
layout) (Int -> NPatchInfo) -> f Int -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
left
{-# INLINE _nPatchInfo'left #-}
_nPatchInfo'top :: Lens' RL.NPatchInfo Int
_nPatchInfo'top :: Lens' NPatchInfo Int
_nPatchInfo'top Int -> f Int
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\Int
top' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source Int
left Int
top' Int
right Int
bottom NPatchLayout
layout) (Int -> NPatchInfo) -> f Int -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
top
{-# INLINE _nPatchInfo'top #-}
_nPatchInfo'right :: Lens' RL.NPatchInfo Int
_nPatchInfo'right :: Lens' NPatchInfo Int
_nPatchInfo'right Int -> f Int
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\Int
right' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source Int
left Int
top Int
right' Int
bottom NPatchLayout
layout) (Int -> NPatchInfo) -> f Int -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
right
{-# INLINE _nPatchInfo'right #-}
_nPatchInfo'bottom :: Lens' RL.NPatchInfo Int
_nPatchInfo'bottom :: Lens' NPatchInfo Int
_nPatchInfo'bottom Int -> f Int
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\Int
bottom' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom' NPatchLayout
layout) (Int -> NPatchInfo) -> f Int -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
bottom
{-# INLINE _nPatchInfo'bottom #-}
_nPatchInfo'layout :: Lens' RL.NPatchInfo RL.NPatchLayout
_nPatchInfo'layout :: Lens' NPatchInfo NPatchLayout
_nPatchInfo'layout NPatchLayout -> f NPatchLayout
f (RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout) =
    (\NPatchLayout
layout' -> Rectangle -> Int -> Int -> Int -> Int -> NPatchLayout -> NPatchInfo
RL.NPatchInfo Rectangle
source Int
left Int
top Int
right Int
bottom NPatchLayout
layout') (NPatchLayout -> NPatchInfo) -> f NPatchLayout -> f NPatchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NPatchLayout -> f NPatchLayout
f NPatchLayout
layout
{-# INLINE _nPatchInfo'layout #-}


_glyphInfo'value :: Lens' RL.GlyphInfo Int
_glyphInfo'value :: Lens' GlyphInfo Int
_glyphInfo'value Int -> f Int
f (RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) =
    (\Int
value' -> Int -> Int -> Int -> Int -> Image -> GlyphInfo
RL.GlyphInfo Int
value' Int
offsetX Int
offsetY Int
advanceX Image
image) (Int -> GlyphInfo) -> f Int -> f GlyphInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
value
{-# INLINE _glyphInfo'value #-}
_glyphInfo'offsetX :: Lens' RL.GlyphInfo Int
_glyphInfo'offsetX :: Lens' GlyphInfo Int
_glyphInfo'offsetX Int -> f Int
f (RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) =
    (\Int
offsetX' -> Int -> Int -> Int -> Int -> Image -> GlyphInfo
RL.GlyphInfo Int
value Int
offsetX' Int
offsetY Int
advanceX Image
image) (Int -> GlyphInfo) -> f Int -> f GlyphInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
offsetX
{-# INLINE _glyphInfo'offsetX #-}
_glyphInfo'offsetY :: Lens' RL.GlyphInfo Int
_glyphInfo'offsetY :: Lens' GlyphInfo Int
_glyphInfo'offsetY Int -> f Int
f (RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) =
    (\Int
offsetY' -> Int -> Int -> Int -> Int -> Image -> GlyphInfo
RL.GlyphInfo Int
value Int
offsetX Int
offsetY' Int
advanceX Image
image) (Int -> GlyphInfo) -> f Int -> f GlyphInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
offsetY
{-# INLINE _glyphInfo'offsetY #-}
_glyphInfo'advanceX :: Lens' RL.GlyphInfo Int
_glyphInfo'advanceX :: Lens' GlyphInfo Int
_glyphInfo'advanceX Int -> f Int
f (RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) =
    (\Int
advanceX' -> Int -> Int -> Int -> Int -> Image -> GlyphInfo
RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX' Image
image) (Int -> GlyphInfo) -> f Int -> f GlyphInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
advanceX
{-# INLINE _glyphInfo'advanceX #-}
_glyphInfo'image :: Lens' RL.GlyphInfo RL.Image
_glyphInfo'image :: Lens' GlyphInfo Image
_glyphInfo'image Image -> f Image
f (RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image) =
    (\Image
image' -> Int -> Int -> Int -> Int -> Image -> GlyphInfo
RL.GlyphInfo Int
value Int
offsetX Int
offsetY Int
advanceX Image
image') (Image -> GlyphInfo) -> f Image -> f GlyphInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image -> f Image
f Image
image
{-# INLINE _glyphInfo'image #-}


_font'baseSize :: Lens' RL.Font Int
_font'baseSize :: Lens' Font Int
_font'baseSize Int -> f Int
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\Int
baseSize' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize' Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) (Int -> Font) -> f Int -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
baseSize
{-# INLINE _font'baseSize #-}
_font'glyphCount :: Lens' RL.Font Int
_font'glyphCount :: Lens' Font Int
_font'glyphCount Int -> f Int
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\Int
glyphCount' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize Int
glyphCount' Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) (Int -> Font) -> f Int -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
glyphCount
{-# INLINE _font'glyphCount #-}
_font'glyphPadding :: Lens' RL.Font Int
_font'glyphPadding :: Lens' Font Int
_font'glyphPadding Int -> f Int
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\Int
glyphPadding' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize Int
glyphCount Int
glyphPadding' Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) (Int -> Font) -> f Int -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
glyphPadding
{-# INLINE _font'glyphPadding #-}
_font'texture :: Lens' RL.Font RL.Texture
_font'texture :: Lens' Font Texture
_font'texture Texture -> f Texture
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\Texture
texture' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture' [Rectangle]
recs [GlyphInfo]
glyphs) (Texture -> Font) -> f Texture -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Texture -> f Texture
f Texture
texture
{-# INLINE _font'texture #-}
_font'recs :: Lens' RL.Font [RL.Rectangle]
_font'recs :: Lens' Font [Rectangle]
_font'recs [Rectangle] -> f [Rectangle]
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\[Rectangle]
recs' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs' [GlyphInfo]
glyphs) ([Rectangle] -> Font) -> f [Rectangle] -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rectangle] -> f [Rectangle]
f [Rectangle]
recs
{-# INLINE _font'recs #-}
_font'glyphs :: Lens' RL.Font [RL.GlyphInfo]
_font'glyphs :: Lens' Font [GlyphInfo]
_font'glyphs [GlyphInfo] -> f [GlyphInfo]
f (RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs) =
    (\[GlyphInfo]
glyphs' -> Int -> Int -> Int -> Texture -> [Rectangle] -> [GlyphInfo] -> Font
RL.Font Int
baseSize Int
glyphCount Int
glyphPadding Texture
texture [Rectangle]
recs [GlyphInfo]
glyphs') ([GlyphInfo] -> Font) -> f [GlyphInfo] -> f Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlyphInfo] -> f [GlyphInfo]
f [GlyphInfo]
glyphs
{-# INLINE _font'glyphs #-}


_camera3D'position :: Lens' RL.Camera3D RL.Vector3
_camera3D'position :: Lens' Camera3D Vector3
_camera3D'position Vector3 -> f Vector3
f (RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) =
    (\Vector3
position' -> Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
RL.Camera3D Vector3
position' Vector3
target Vector3
up Float
fovy CameraProjection
projection) (Vector3 -> Camera3D) -> f Vector3 -> f Camera3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
position
{-# INLINE _camera3D'position #-}
_camera3D'target :: Lens' RL.Camera3D RL.Vector3
_camera3D'target :: Lens' Camera3D Vector3
_camera3D'target Vector3 -> f Vector3
f (RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) =
    (\Vector3
target' -> Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
RL.Camera3D Vector3
position Vector3
target' Vector3
up Float
fovy CameraProjection
projection) (Vector3 -> Camera3D) -> f Vector3 -> f Camera3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
target
{-# INLINE _camera3D'target #-}
_camera3D'up :: Lens' RL.Camera3D RL.Vector3
_camera3D'up :: Lens' Camera3D Vector3
_camera3D'up Vector3 -> f Vector3
f (RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) =
    (\Vector3
up' -> Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
RL.Camera3D Vector3
position Vector3
target Vector3
up' Float
fovy CameraProjection
projection) (Vector3 -> Camera3D) -> f Vector3 -> f Camera3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
up
{-# INLINE _camera3D'up #-}
_camera3D'fovy :: Lens' RL.Camera3D Float
_camera3D'fovy :: Lens' Camera3D Float
_camera3D'fovy Float -> f Float
f (RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) =
    (\Float
fovy' -> Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy' CameraProjection
projection) (Float -> Camera3D) -> f Float -> f Camera3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
fovy
{-# INLINE _camera3D'fovy #-}
_camera3D'projection :: Lens' RL.Camera3D RL.CameraProjection
_camera3D'projection :: Lens' Camera3D CameraProjection
_camera3D'projection CameraProjection -> f CameraProjection
f (RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection) =
    (\CameraProjection
projection' -> Vector3
-> Vector3 -> Vector3 -> Float -> CameraProjection -> Camera3D
RL.Camera3D Vector3
position Vector3
target Vector3
up Float
fovy CameraProjection
projection') (CameraProjection -> Camera3D) -> f CameraProjection -> f Camera3D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CameraProjection -> f CameraProjection
f CameraProjection
projection
{-# INLINE _camera3D'projection #-}


_camera2D'offset :: Lens' RL.Camera2D RL.Vector2
_camera2D'offset :: Lens' Camera2D Vector2
_camera2D'offset Vector2 -> f Vector2
f (RL.Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom) =
    (\Vector2
offset' -> Vector2 -> Vector2 -> Float -> Float -> Camera2D
RL.Camera2D Vector2
offset' Vector2
target Float
rotation Float
zoom) (Vector2 -> Camera2D) -> f Vector2 -> f Camera2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> f Vector2
f Vector2
offset
{-# INLINE _camera2D'offset #-}
_camera2D'target :: Lens' RL.Camera2D RL.Vector2
_camera2D'target :: Lens' Camera2D Vector2
_camera2D'target Vector2 -> f Vector2
f (RL.Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom) =
    (\Vector2
target' -> Vector2 -> Vector2 -> Float -> Float -> Camera2D
RL.Camera2D Vector2
offset Vector2
target' Float
rotation Float
zoom) (Vector2 -> Camera2D) -> f Vector2 -> f Camera2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> f Vector2
f Vector2
target
{-# INLINE _camera2D'target #-}
_camera2D'rotation :: Lens' RL.Camera2D Float
_camera2D'rotation :: Lens' Camera2D Float
_camera2D'rotation Float -> f Float
f (RL.Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom) =
    (\Float
rotation' -> Vector2 -> Vector2 -> Float -> Float -> Camera2D
RL.Camera2D Vector2
offset Vector2
target Float
rotation' Float
zoom) (Float -> Camera2D) -> f Float -> f Camera2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
rotation
{-# INLINE _camera2D'rotation #-}
_camera2D'zoom :: Lens' RL.Camera2D Float
_camera2D'zoom :: Lens' Camera2D Float
_camera2D'zoom Float -> f Float
f (RL.Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom) =
    (\Float
zoom' -> Vector2 -> Vector2 -> Float -> Float -> Camera2D
RL.Camera2D Vector2
offset Vector2
target Float
rotation Float
zoom') (Float -> Camera2D) -> f Float -> f Camera2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
zoom
{-# INLINE _camera2D'zoom #-}


_mesh'vertexCount :: Lens' RL.Mesh Int
_mesh'vertexCount :: Lens' Mesh Int
_mesh'vertexCount Int -> f Int
f Mesh
mesh =
    (\Int
vertexCount' -> Mesh
mesh { RL.mesh'vertexCount = vertexCount' }) (Int -> Mesh) -> f Int -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (Mesh -> Int
RL.mesh'vertexCount Mesh
mesh)
{-# INLINE _mesh'vertexCount #-}
_mesh'triangleCount :: Lens' RL.Mesh Int
_mesh'triangleCount :: Lens' Mesh Int
_mesh'triangleCount Int -> f Int
f Mesh
mesh =
    (\Int
triangleCount' -> Mesh
mesh { RL.mesh'triangleCount = triangleCount' }) (Int -> Mesh) -> f Int -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (Mesh -> Int
RL.mesh'triangleCount Mesh
mesh)
{-# INLINE _mesh'triangleCount #-}
_mesh'vertices :: Lens' RL.Mesh [RL.Vector3]
_mesh'vertices :: Lens' Mesh [Vector3]
_mesh'vertices [Vector3] -> f [Vector3]
f Mesh
mesh =
    (\[Vector3]
vertices' -> Mesh
mesh { RL.mesh'vertices = vertices' }) ([Vector3] -> Mesh) -> f [Vector3] -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Vector3] -> f [Vector3]
f (Mesh -> [Vector3]
RL.mesh'vertices Mesh
mesh)
{-# INLINE _mesh'vertices #-}
_mesh'texcoords :: Lens' RL.Mesh [RL.Vector2]
_mesh'texcoords :: Lens' Mesh [Vector2]
_mesh'texcoords [Vector2] -> f [Vector2]
f Mesh
mesh =
    (\[Vector2]
texcoords' -> Mesh
mesh { RL.mesh'texcoords = texcoords' }) ([Vector2] -> Mesh) -> f [Vector2] -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Vector2] -> f [Vector2]
f (Mesh -> [Vector2]
RL.mesh'texcoords Mesh
mesh)
{-# INLINE _mesh'texcoords #-}
_mesh'texcoords2 :: Lens' RL.Mesh (Maybe [RL.Vector2])
_mesh'texcoords2 :: Lens' Mesh (Maybe [Vector2])
_mesh'texcoords2 Maybe [Vector2] -> f (Maybe [Vector2])
f Mesh
mesh =
    (\Maybe [Vector2]
texcoords2' -> Mesh
mesh { RL.mesh'texcoords2 = texcoords2' }) (Maybe [Vector2] -> Mesh) -> f (Maybe [Vector2]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Vector2] -> f (Maybe [Vector2])
f (Mesh -> Maybe [Vector2]
RL.mesh'texcoords2 Mesh
mesh)
{-# INLINE _mesh'texcoords2 #-}
_mesh'normals :: Lens' RL.Mesh [RL.Vector3]
_mesh'normals :: Lens' Mesh [Vector3]
_mesh'normals [Vector3] -> f [Vector3]
f Mesh
mesh =
    (\[Vector3]
normals' -> Mesh
mesh { RL.mesh'normals = normals' }) ([Vector3] -> Mesh) -> f [Vector3] -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Vector3] -> f [Vector3]
f (Mesh -> [Vector3]
RL.mesh'normals Mesh
mesh)
{-# INLINE _mesh'normals #-}
_mesh'tangents :: Lens' RL.Mesh (Maybe [RL.Vector4])
_mesh'tangents :: Lens' Mesh (Maybe [Vector4])
_mesh'tangents Maybe [Vector4] -> f (Maybe [Vector4])
f Mesh
mesh =
    (\Maybe [Vector4]
tangents' -> Mesh
mesh { RL.mesh'tangents = tangents' }) (Maybe [Vector4] -> Mesh) -> f (Maybe [Vector4]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Vector4] -> f (Maybe [Vector4])
f (Mesh -> Maybe [Vector4]
RL.mesh'tangents Mesh
mesh)
{-# INLINE _mesh'tangents #-}
_mesh'colors :: Lens' RL.Mesh (Maybe [RL.Color])
_mesh'colors :: Lens' Mesh (Maybe [Color])
_mesh'colors Maybe [Color] -> f (Maybe [Color])
f Mesh
mesh =
    (\Maybe [Color]
colors' -> Mesh
mesh { RL.mesh'colors = colors' }) (Maybe [Color] -> Mesh) -> f (Maybe [Color]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Color] -> f (Maybe [Color])
f (Mesh -> Maybe [Color]
RL.mesh'colors Mesh
mesh)
{-# INLINE _mesh'colors #-}
_mesh'indices :: Lens' RL.Mesh (Maybe [Word16])
_mesh'indices :: Lens' Mesh (Maybe [Word16])
_mesh'indices Maybe [Word16] -> f (Maybe [Word16])
f Mesh
mesh =
    (\Maybe [Word16]
indices' -> Mesh
mesh { RL.mesh'indices = indices' }) (Maybe [Word16] -> Mesh) -> f (Maybe [Word16]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Word16] -> f (Maybe [Word16])
f (Mesh -> Maybe [Word16]
RL.mesh'indices Mesh
mesh)
{-# INLINE _mesh'indices #-}
_mesh'animVertices :: Lens' RL.Mesh (Maybe [RL.Vector3])
_mesh'animVertices :: Lens' Mesh (Maybe [Vector3])
_mesh'animVertices Maybe [Vector3] -> f (Maybe [Vector3])
f Mesh
mesh =
    (\Maybe [Vector3]
animVertices' -> Mesh
mesh { RL.mesh'animVertices = animVertices' }) (Maybe [Vector3] -> Mesh) -> f (Maybe [Vector3]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Vector3] -> f (Maybe [Vector3])
f (Mesh -> Maybe [Vector3]
RL.mesh'animVertices Mesh
mesh)
{-# INLINE _mesh'animVertices #-}
_mesh'animNormals :: Lens' RL.Mesh (Maybe [RL.Vector3])
_mesh'animNormals :: Lens' Mesh (Maybe [Vector3])
_mesh'animNormals Maybe [Vector3] -> f (Maybe [Vector3])
f Mesh
mesh =
    (\Maybe [Vector3]
animNormals' -> Mesh
mesh { RL.mesh'animNormals = animNormals' }) (Maybe [Vector3] -> Mesh) -> f (Maybe [Vector3]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Vector3] -> f (Maybe [Vector3])
f (Mesh -> Maybe [Vector3]
RL.mesh'animNormals Mesh
mesh)
{-# INLINE _mesh'animNormals #-}
_mesh'boneIds :: Lens' RL.Mesh (Maybe [Word8])
_mesh'boneIds :: Lens' Mesh (Maybe [Word8])
_mesh'boneIds Maybe [Word8] -> f (Maybe [Word8])
f Mesh
mesh =
    (\Maybe [Word8]
boneIds' -> Mesh
mesh { RL.mesh'boneIds = boneIds' }) (Maybe [Word8] -> Mesh) -> f (Maybe [Word8]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Word8] -> f (Maybe [Word8])
f (Mesh -> Maybe [Word8]
RL.mesh'boneIds Mesh
mesh)
{-# INLINE _mesh'boneIds #-}
_mesh'boneWeights :: Lens' RL.Mesh (Maybe [Float])
_mesh'boneWeights :: Lens' Mesh (Maybe [Float])
_mesh'boneWeights Maybe [Float] -> f (Maybe [Float])
f Mesh
mesh =
    (\Maybe [Float]
boneWeights' -> Mesh
mesh { RL.mesh'boneWeights = boneWeights' }) (Maybe [Float] -> Mesh) -> f (Maybe [Float]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Float] -> f (Maybe [Float])
f (Mesh -> Maybe [Float]
RL.mesh'boneWeights Mesh
mesh)
{-# INLINE _mesh'boneWeights #-}
_mesh'vaoId :: Lens' RL.Mesh Integer
_mesh'vaoId :: Lens' Mesh Integer
_mesh'vaoId Integer -> f Integer
f Mesh
mesh =
    (\Integer
vaoId' -> Mesh
mesh { RL.mesh'vaoId = vaoId' }) (Integer -> Mesh) -> f Integer -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f (Mesh -> Integer
RL.mesh'vaoId Mesh
mesh)
{-# INLINE _mesh'vaoId #-}
_mesh'vboId :: Lens' RL.Mesh (Maybe [Integer])
_mesh'vboId :: Lens' Mesh (Maybe [Integer])
_mesh'vboId Maybe [Integer] -> f (Maybe [Integer])
f Mesh
mesh =
    (\Maybe [Integer]
vboId' -> Mesh
mesh { RL.mesh'vboId = vboId' }) (Maybe [Integer] -> Mesh) -> f (Maybe [Integer]) -> f Mesh
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe [Integer] -> f (Maybe [Integer])
f (Mesh -> Maybe [Integer]
RL.mesh'vboId Mesh
mesh)
{-# INLINE _mesh'vboId #-}


_shader'id :: Lens' RL.Shader Integer
_shader'id :: Lens' Shader Integer
_shader'id Integer -> f Integer
f (RL.Shader Integer
ident [Int]
locs) = (\Integer
ident' -> Integer -> [Int] -> Shader
RL.Shader Integer
ident' [Int]
locs) (Integer -> Shader) -> f Integer -> f Shader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
ident
{-# INLINE _shader'id #-}
_shader'locs :: Lens' RL.Shader [Int]
_shader'locs :: Lens' Shader [Int]
_shader'locs [Int] -> f [Int]
f (RL.Shader Integer
ident [Int]
locs) = (\[Int]
locs' -> Integer -> [Int] -> Shader
RL.Shader Integer
ident [Int]
locs') ([Int] -> Shader) -> f [Int] -> f Shader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> f [Int]
f [Int]
locs
{-# INLINE _shader'locs #-}


_materialMap'texture :: Lens' RL.MaterialMap RL.Texture
_materialMap'texture :: Lens' MaterialMap Texture
_materialMap'texture Texture -> f Texture
f (RL.MaterialMap Texture
texture Color
color Float
value) =
    (\Texture
texture' -> Texture -> Color -> Float -> MaterialMap
RL.MaterialMap Texture
texture' Color
color Float
value) (Texture -> MaterialMap) -> f Texture -> f MaterialMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Texture -> f Texture
f Texture
texture
{-# INLINE _materialMap'texture #-}
_materialMap'color :: Lens' RL.MaterialMap RL.Color
_materialMap'color :: Lens' MaterialMap Color
_materialMap'color Color -> f Color
f (RL.MaterialMap Texture
texture Color
color Float
value) =
    (\Color
color' -> Texture -> Color -> Float -> MaterialMap
RL.MaterialMap Texture
texture Color
color' Float
value) (Color -> MaterialMap) -> f Color -> f MaterialMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Color -> f Color
f Color
color
{-# INLINE _materialMap'color #-}
_materialMap'value :: Lens' RL.MaterialMap Float
_materialMap'value :: Lens' MaterialMap Float
_materialMap'value Float -> f Float
f (RL.MaterialMap Texture
texture Color
color Float
value) =
    (\Float
value' -> Texture -> Color -> Float -> MaterialMap
RL.MaterialMap Texture
texture Color
color Float
value') (Float -> MaterialMap) -> f Float -> f MaterialMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
value
{-# INLINE _materialMap'value #-}


_material'shader :: Lens' RL.Material RL.Shader
_material'shader :: Lens' Material Shader
_material'shader Shader -> f Shader
f (RL.Material Shader
shader Maybe [MaterialMap]
maps [Float]
params) =
    (\Shader
shader' -> Shader -> Maybe [MaterialMap] -> [Float] -> Material
RL.Material Shader
shader' Maybe [MaterialMap]
maps [Float]
params) (Shader -> Material) -> f Shader -> f Material
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shader -> f Shader
f Shader
shader
{-# INLINE _material'shader #-}
_material'maps :: Lens' RL.Material (Maybe [RL.MaterialMap])
_material'maps :: Lens' Material (Maybe [MaterialMap])
_material'maps Maybe [MaterialMap] -> f (Maybe [MaterialMap])
f (RL.Material Shader
shader Maybe [MaterialMap]
maps [Float]
params) =
    (\Maybe [MaterialMap]
maps' -> Shader -> Maybe [MaterialMap] -> [Float] -> Material
RL.Material Shader
shader Maybe [MaterialMap]
maps' [Float]
params) (Maybe [MaterialMap] -> Material)
-> f (Maybe [MaterialMap]) -> f Material
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [MaterialMap] -> f (Maybe [MaterialMap])
f Maybe [MaterialMap]
maps
{-# INLINE _material'maps #-}
_material'params :: Lens' RL.Material [Float]
_material'params :: Lens' Material [Float]
_material'params [Float] -> f [Float]
f (RL.Material Shader
shader Maybe [MaterialMap]
maps [Float]
params) =
    (\[Float]
params' -> Shader -> Maybe [MaterialMap] -> [Float] -> Material
RL.Material Shader
shader Maybe [MaterialMap]
maps [Float]
params') ([Float] -> Material) -> f [Float] -> f Material
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Float] -> f [Float]
f [Float]
params
{-# INLINE _material'params #-}


_transform'translation :: Lens' RL.Transform RL.Vector3
_transform'translation :: Lens' Transform Vector3
_transform'translation Vector3 -> f Vector3
f (RL.Transform Vector3
translation Vector4
rotation Vector3
scale) =
    (\Vector3
translation' -> Vector3 -> Vector4 -> Vector3 -> Transform
RL.Transform Vector3
translation' Vector4
rotation Vector3
scale) (Vector3 -> Transform) -> f Vector3 -> f Transform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
translation
{-# INLINE _transform'translation #-}
_transform'rotation :: Lens' RL.Transform RL.Quaternion
_transform'rotation :: Lens' Transform Vector4
_transform'rotation Vector4 -> f Vector4
f (RL.Transform Vector3
translation Vector4
rotation Vector3
scale) =
    (\Vector4
rotation' -> Vector3 -> Vector4 -> Vector3 -> Transform
RL.Transform Vector3
translation Vector4
rotation' Vector3
scale) (Vector4 -> Transform) -> f Vector4 -> f Transform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector4 -> f Vector4
f Vector4
rotation
{-# INLINE _transform'rotation #-}
_transform'scale :: Lens' RL.Transform RL.Vector3
_transform'scale :: Lens' Transform Vector3
_transform'scale Vector3 -> f Vector3
f (RL.Transform Vector3
translation Vector4
rotation Vector3
scale) =
    (\Vector3
scale' -> Vector3 -> Vector4 -> Vector3 -> Transform
RL.Transform Vector3
translation Vector4
rotation Vector3
scale') (Vector3 -> Transform) -> f Vector3 -> f Transform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
scale
{-# INLINE _transform'scale #-}


_boneInfo'name :: Lens' RL.BoneInfo String
_boneInfo'name :: Lens' BoneInfo String
_boneInfo'name String -> f String
f (RL.BoneInfo String
name Int
parent) = (\String
name' -> String -> Int -> BoneInfo
RL.BoneInfo String
name' Int
parent) (String -> BoneInfo) -> f String -> f BoneInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
name
{-# INLINE _boneInfo'name #-}
_boneInfo'parent :: Lens' RL.BoneInfo Int
_boneInfo'parent :: Lens' BoneInfo Int
_boneInfo'parent Int -> f Int
f (RL.BoneInfo String
name Int
parent) = (\Int
parent' -> String -> Int -> BoneInfo
RL.BoneInfo String
name Int
parent') (Int -> BoneInfo) -> f Int -> f BoneInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
parent
{-# INLINE _boneInfo'parent #-}


_model'transform :: Lens' RL.Model RL.Matrix
_model'transform :: Lens' Model Matrix
_model'transform Matrix -> f Matrix
f Model
model =
    (\Matrix
transform' -> Model
model { RL.model'transform = transform' }) (Matrix -> Model) -> f Matrix -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Matrix -> f Matrix
f (Model -> Matrix
RL.model'transform Model
model)
{-# INLINE _model'transform #-}
_model'meshes :: Lens' RL.Model [RL.Mesh]
_model'meshes :: Lens' Model [Mesh]
_model'meshes [Mesh] -> f [Mesh]
f Model
model =
    (\[Mesh]
meshes' -> Model
model { RL.model'meshes = meshes' }) ([Mesh] -> Model) -> f [Mesh] -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Mesh] -> f [Mesh]
f (Model -> [Mesh]
RL.model'meshes Model
model)
{-# INLINE _model'meshes #-}
_model'materials :: Lens' RL.Model [RL.Material]
_model'materials :: Lens' Model [Material]
_model'materials [Material] -> f [Material]
f Model
model =
    (\[Material]
materials' -> Model
model { RL.model'materials = materials' }) ([Material] -> Model) -> f [Material] -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Material] -> f [Material]
f (Model -> [Material]
RL.model'materials Model
model)
{-# INLINE _model'materials #-}
_model'meshMaterial :: Lens' RL.Model [Int]
_model'meshMaterial :: Lens' Model [Int]
_model'meshMaterial [Int] -> f [Int]
f Model
model =
    (\[Int]
meshMaterial' -> Model
model { RL.model'meshMaterial = meshMaterial' }) ([Int] -> Model) -> f [Int] -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> f [Int]
f (Model -> [Int]
RL.model'meshMaterial Model
model)
{-# INLINE _model'meshMaterial #-}
_model'boneCount :: Lens' RL.Model Int
_model'boneCount :: Lens' Model Int
_model'boneCount Int -> f Int
f Model
model =
    (\Int
boneCount' -> Model
model { RL.model'boneCount = boneCount' }) (Int -> Model) -> f Int -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (Model -> Int
RL.model'boneCount Model
model)
{-# INLINE _model'boneCount #-}
_model'bones :: Lens' RL.Model (Maybe [RL.BoneInfo])
_model'bones :: Lens' Model (Maybe [BoneInfo])
_model'bones Maybe [BoneInfo] -> f (Maybe [BoneInfo])
f Model
model =
    (\Maybe [BoneInfo]
bones' -> Model
model { RL.model'bones = bones' }) (Maybe [BoneInfo] -> Model) -> f (Maybe [BoneInfo]) -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [BoneInfo] -> f (Maybe [BoneInfo])
f (Model -> Maybe [BoneInfo]
RL.model'bones Model
model)
{-# INLINE _model'bones #-}
_model'bindPose :: Lens' RL.Model (Maybe [RL.Transform])
_model'bindPose :: Lens' Model (Maybe [Transform])
_model'bindPose Maybe [Transform] -> f (Maybe [Transform])
f Model
model =
    (\Maybe [Transform]
bindPose' -> Model
model { RL.model'bindPose = bindPose' }) (Maybe [Transform] -> Model) -> f (Maybe [Transform]) -> f Model
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Transform] -> f (Maybe [Transform])
f (Model -> Maybe [Transform]
RL.model'bindPose Model
model)
{-# INLINE _model'bindPose #-}


_modelAnimation'boneCount :: Lens' RL.ModelAnimation Int
_modelAnimation'boneCount :: Lens' ModelAnimation Int
_modelAnimation'boneCount Int -> f Int
f (RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) =
    (\Int
boneCount' -> Int
-> Int -> [BoneInfo] -> [[Transform]] -> String -> ModelAnimation
RL.ModelAnimation Int
boneCount' Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) (Int -> ModelAnimation) -> f Int -> f ModelAnimation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
boneCount
{-# INLINE _modelAnimation'boneCount #-}
_modelAnimation'frameCount :: Lens' RL.ModelAnimation Int
_modelAnimation'frameCount :: Lens' ModelAnimation Int
_modelAnimation'frameCount Int -> f Int
f (RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) =
    (\Int
frameCount' -> Int
-> Int -> [BoneInfo] -> [[Transform]] -> String -> ModelAnimation
RL.ModelAnimation Int
boneCount Int
frameCount' [BoneInfo]
bones [[Transform]]
framePoses String
name) (Int -> ModelAnimation) -> f Int -> f ModelAnimation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
frameCount
{-# INLINE _modelAnimation'frameCount #-}
_modelAnimation'bones :: Lens' RL.ModelAnimation [RL.BoneInfo]
_modelAnimation'bones :: Lens' ModelAnimation [BoneInfo]
_modelAnimation'bones [BoneInfo] -> f [BoneInfo]
f (RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) =
    (\[BoneInfo]
bones' -> Int
-> Int -> [BoneInfo] -> [[Transform]] -> String -> ModelAnimation
RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones' [[Transform]]
framePoses String
name) ([BoneInfo] -> ModelAnimation) -> f [BoneInfo] -> f ModelAnimation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BoneInfo] -> f [BoneInfo]
f [BoneInfo]
bones
{-# INLINE _modelAnimation'bones #-}
_modelAnimation'framePoses :: Lens' RL.ModelAnimation [[RL.Transform]]
_modelAnimation'framePoses :: Lens' ModelAnimation [[Transform]]
_modelAnimation'framePoses [[Transform]] -> f [[Transform]]
f (RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) =
    (\[[Transform]]
framePoses' -> Int
-> Int -> [BoneInfo] -> [[Transform]] -> String -> ModelAnimation
RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses' String
name) ([[Transform]] -> ModelAnimation)
-> f [[Transform]] -> f ModelAnimation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Transform]] -> f [[Transform]]
f [[Transform]]
framePoses
{-# INLINE _modelAnimation'framePoses #-}
_modelAnimation'name :: Lens' RL.ModelAnimation String
_modelAnimation'name :: Lens' ModelAnimation String
_modelAnimation'name String -> f String
f (RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name) =
    (\String
name' -> Int
-> Int -> [BoneInfo] -> [[Transform]] -> String -> ModelAnimation
RL.ModelAnimation Int
boneCount Int
frameCount [BoneInfo]
bones [[Transform]]
framePoses String
name') (String -> ModelAnimation) -> f String -> f ModelAnimation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
f String
name
{-# INLINE _modelAnimation'name #-}


_ray'position :: Lens' RL.Ray RL.Vector3
_ray'position :: Lens' Ray Vector3
_ray'position Vector3 -> f Vector3
f (RL.Ray Vector3
position Vector3
direction) = (\Vector3
position' -> Vector3 -> Vector3 -> Ray
RL.Ray Vector3
position' Vector3
direction) (Vector3 -> Ray) -> f Vector3 -> f Ray
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
position
{-# INLINE _ray'position #-}
_ray'direction :: Lens' RL.Ray RL.Vector3
_ray'direction :: Lens' Ray Vector3
_ray'direction Vector3 -> f Vector3
f (RL.Ray Vector3
position Vector3
direction) = (\Vector3
direction' -> Vector3 -> Vector3 -> Ray
RL.Ray Vector3
position Vector3
direction') (Vector3 -> Ray) -> f Vector3 -> f Ray
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
direction
{-# INLINE _ray'direction #-}


_rayCollision'hit :: Lens' RL.RayCollision Bool
_rayCollision'hit :: Lens' RayCollision Bool
_rayCollision'hit Bool -> f Bool
f (RL.RayCollision Bool
hit Float
distance Vector3
point Vector3
normal) =
    (\Bool
hit' -> Bool -> Float -> Vector3 -> Vector3 -> RayCollision
RL.RayCollision Bool
hit' Float
distance Vector3
point Vector3
normal) (Bool -> RayCollision) -> f Bool -> f RayCollision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
hit
{-# INLINE _rayCollision'hit #-}
_rayCollision'distance :: Lens' RL.RayCollision Float
_rayCollision'distance :: Lens' RayCollision Float
_rayCollision'distance Float -> f Float
f (RL.RayCollision Bool
hit Float
distance Vector3
point Vector3
normal) =
    (\Float
distance' -> Bool -> Float -> Vector3 -> Vector3 -> RayCollision
RL.RayCollision Bool
hit Float
distance' Vector3
point Vector3
normal) (Float -> RayCollision) -> f Float -> f RayCollision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Float -> f Float
f Float
distance
{-# INLINE _rayCollision'distance #-}
_rayCollision'point :: Lens' RL.RayCollision RL.Vector3
_rayCollision'point :: Lens' RayCollision Vector3
_rayCollision'point Vector3 -> f Vector3
f (RL.RayCollision Bool
hit Float
distance Vector3
point Vector3
normal) =
    (\Vector3
point' -> Bool -> Float -> Vector3 -> Vector3 -> RayCollision
RL.RayCollision Bool
hit Float
distance Vector3
point' Vector3
normal) (Vector3 -> RayCollision) -> f Vector3 -> f RayCollision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
point
{-# INLINE _rayCollision'point #-}
_rayCollision'normal :: Lens' RL.RayCollision RL.Vector3
_rayCollision'normal :: Lens' RayCollision Vector3
_rayCollision'normal Vector3 -> f Vector3
f (RL.RayCollision Bool
hit Float
distance Vector3
point Vector3
normal) =
    (\Vector3
normal' -> Bool -> Float -> Vector3 -> Vector3 -> RayCollision
RL.RayCollision Bool
hit Float
distance Vector3
point Vector3
normal') (Vector3 -> RayCollision) -> f Vector3 -> f RayCollision
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
normal
{-# INLINE _rayCollision'normal #-}


_boundingBox'min :: Lens' RL.BoundingBox RL.Vector3
_boundingBox'min :: Lens' BoundingBox Vector3
_boundingBox'min Vector3 -> f Vector3
f (RL.BoundingBox Vector3
bbMin Vector3
bbMax) = (\Vector3
bbMin' -> Vector3 -> Vector3 -> BoundingBox
RL.BoundingBox Vector3
bbMin' Vector3
bbMax) (Vector3 -> BoundingBox) -> f Vector3 -> f BoundingBox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
bbMin
{-# INLINE _boundingBox'min #-}
_boundingBox'max :: Lens' RL.BoundingBox RL.Vector3
_boundingBox'max :: Lens' BoundingBox Vector3
_boundingBox'max Vector3 -> f Vector3
f (RL.BoundingBox Vector3
bbMin Vector3
bbMax) = (\Vector3
bbMax' -> Vector3 -> Vector3 -> BoundingBox
RL.BoundingBox Vector3
bbMin Vector3
bbMax') (Vector3 -> BoundingBox) -> f Vector3 -> f BoundingBox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector3 -> f Vector3
f Vector3
bbMax
{-# INLINE _boundingBox'max #-}


_wave'frameCount :: Lens' RL.Wave Integer
_wave'frameCount :: Lens' Wave Integer
_wave'frameCount Integer -> f Integer
f (RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) =
    (\Integer
frameCount' -> Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
RL.Wave Integer
frameCount' Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) (Integer -> Wave) -> f Integer -> f Wave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
frameCount
{-# INLINE _wave'frameCount #-}
_wave'sampleRate :: Lens' RL.Wave Integer
_wave'sampleRate :: Lens' Wave Integer
_wave'sampleRate Integer -> f Integer
f (RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) =
    (\Integer
sampleRate' -> Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
RL.Wave Integer
frameCount Integer
sampleRate' Integer
sampleSize Integer
channels [Int]
waveData) (Integer -> Wave) -> f Integer -> f Wave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
sampleRate
{-# INLINE _wave'sampleRate #-}
_wave'sampleSize :: Lens' RL.Wave Integer
_wave'sampleSize :: Lens' Wave Integer
_wave'sampleSize Integer -> f Integer
f (RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) =
    (\Integer
sampleSize' -> Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize' Integer
channels [Int]
waveData) (Integer -> Wave) -> f Integer -> f Wave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
sampleSize
{-# INLINE _wave'sampleSize #-}
_wave'channels :: Lens' RL.Wave Integer
_wave'channels :: Lens' Wave Integer
_wave'channels Integer -> f Integer
f (RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) =
    (\Integer
channels' -> Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels' [Int]
waveData) (Integer -> Wave) -> f Integer -> f Wave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
channels
{-# INLINE _wave'channels #-}
_wave'data :: Lens' RL.Wave [Int]
_wave'data :: Lens' Wave [Int]
_wave'data [Int] -> f [Int]
f (RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData) =
    (\[Int]
waveData' -> Integer -> Integer -> Integer -> Integer -> [Int] -> Wave
RL.Wave Integer
frameCount Integer
sampleRate Integer
sampleSize Integer
channels [Int]
waveData') ([Int] -> Wave) -> f [Int] -> f Wave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> f [Int]
f [Int]
waveData
{-# INLINE _wave'data #-}


_rAudioBuffer'converter :: Lens' RL.RAudioBuffer [Int]
_rAudioBuffer'converter :: Lens' RAudioBuffer [Int]
_rAudioBuffer'converter [Int] -> f [Int]
f RAudioBuffer
buffer =
    (\[Int]
converter' -> RAudioBuffer
buffer { RL.rAudioBuffer'converter = converter' }) ([Int] -> RAudioBuffer) -> f [Int] -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Int] -> f [Int]
f (RAudioBuffer -> [Int]
RL.rAudioBuffer'converter RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'converter #-}
_rAudioBuffer'callback :: Lens' RL.RAudioBuffer RL.AudioCallback
_rAudioBuffer'callback :: Lens' RAudioBuffer AudioCallback
_rAudioBuffer'callback AudioCallback -> f AudioCallback
f RAudioBuffer
buffer =
    (\AudioCallback
callback' -> RAudioBuffer
buffer { RL.rAudioBuffer'callback = callback' }) (AudioCallback -> RAudioBuffer)
-> f AudioCallback -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    AudioCallback -> f AudioCallback
f (RAudioBuffer -> AudioCallback
RL.rAudioBuffer'callback RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'callback #-}
_rAudioBuffer'processor :: Lens' RL.RAudioBuffer (Maybe RL.RAudioProcessor)
_rAudioBuffer'processor :: Lens' RAudioBuffer (Maybe RAudioProcessor)
_rAudioBuffer'processor Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f RAudioBuffer
buffer =
    (\Maybe RAudioProcessor
processor' -> RAudioBuffer
buffer { RL.rAudioBuffer'processor = processor' }) (Maybe RAudioProcessor -> RAudioBuffer)
-> f (Maybe RAudioProcessor) -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f (RAudioBuffer -> Maybe RAudioProcessor
RL.rAudioBuffer'processor RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'processor #-}
_rAudioBuffer'volume :: Lens' RL.RAudioBuffer Float
_rAudioBuffer'volume :: Lens' RAudioBuffer Float
_rAudioBuffer'volume Float -> f Float
f RAudioBuffer
buffer =
    (\Float
volume' -> RAudioBuffer
buffer { RL.rAudioBuffer'volume = volume' }) (Float -> RAudioBuffer) -> f Float -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (RAudioBuffer -> Float
RL.rAudioBuffer'volume RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'volume #-}
_rAudioBuffer'pitch :: Lens' RL.RAudioBuffer Float
_rAudioBuffer'pitch :: Lens' RAudioBuffer Float
_rAudioBuffer'pitch Float -> f Float
f RAudioBuffer
buffer =
    (\Float
pitch' -> RAudioBuffer
buffer { RL.rAudioBuffer'pitch = pitch' }) (Float -> RAudioBuffer) -> f Float -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (RAudioBuffer -> Float
RL.rAudioBuffer'pitch RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'pitch #-}
_rAudioBuffer'pan :: Lens' RL.RAudioBuffer Float
_rAudioBuffer'pan :: Lens' RAudioBuffer Float
_rAudioBuffer'pan Float -> f Float
f RAudioBuffer
buffer =
    (\Float
pan' -> RAudioBuffer
buffer { RL.rAudioBuffer'pan = pan' }) (Float -> RAudioBuffer) -> f Float -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (RAudioBuffer -> Float
RL.rAudioBuffer'pan RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'pan #-}
_rAudioBuffer'playing :: Lens' RL.RAudioBuffer Bool
_rAudioBuffer'playing :: Lens' RAudioBuffer Bool
_rAudioBuffer'playing Bool -> f Bool
f RAudioBuffer
buffer =
    (\Bool
playing' -> RAudioBuffer
buffer { RL.rAudioBuffer'playing = playing' }) (Bool -> RAudioBuffer) -> f Bool -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Bool -> f Bool
f (RAudioBuffer -> Bool
RL.rAudioBuffer'playing RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'playing #-}
_rAudioBuffer'paused :: Lens' RL.RAudioBuffer Bool
_rAudioBuffer'paused :: Lens' RAudioBuffer Bool
_rAudioBuffer'paused Bool -> f Bool
f RAudioBuffer
buffer =
    (\Bool
paused' -> RAudioBuffer
buffer { RL.rAudioBuffer'paused = paused' }) (Bool -> RAudioBuffer) -> f Bool -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Bool -> f Bool
f (RAudioBuffer -> Bool
RL.rAudioBuffer'paused RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'paused #-}
_rAudioBuffer'looping :: Lens' RL.RAudioBuffer Bool
_rAudioBuffer'looping :: Lens' RAudioBuffer Bool
_rAudioBuffer'looping Bool -> f Bool
f RAudioBuffer
buffer =
    (\Bool
looping' -> RAudioBuffer
buffer { RL.rAudioBuffer'looping = looping' }) (Bool -> RAudioBuffer) -> f Bool -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Bool -> f Bool
f (RAudioBuffer -> Bool
RL.rAudioBuffer'looping RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'looping #-}
_rAudioBuffer'usage :: Lens' RL.RAudioBuffer Int
_rAudioBuffer'usage :: Lens' RAudioBuffer Int
_rAudioBuffer'usage Int -> f Int
f RAudioBuffer
buffer =
    (\Int
usage' -> RAudioBuffer
buffer { RL.rAudioBuffer'usage = usage' }) (Int -> RAudioBuffer) -> f Int -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (RAudioBuffer -> Int
RL.rAudioBuffer'usage RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'usage #-}
_rAudioBuffer'isSubBufferProcessed :: Lens' RL.RAudioBuffer [Bool]
_rAudioBuffer'isSubBufferProcessed :: Lens' RAudioBuffer [Bool]
_rAudioBuffer'isSubBufferProcessed [Bool] -> f [Bool]
f RAudioBuffer
buffer =
    (\[Bool]
isSubBufferProcessed' -> RAudioBuffer
buffer { RL.rAudioBuffer'isSubBufferProcessed = isSubBufferProcessed' }) ([Bool] -> RAudioBuffer) -> f [Bool] -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Bool] -> f [Bool]
f (RAudioBuffer -> [Bool]
RL.rAudioBuffer'isSubBufferProcessed RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'isSubBufferProcessed #-}
_rAudioBuffer'sizeInFrames :: Lens' RL.RAudioBuffer Integer
_rAudioBuffer'sizeInFrames :: Lens' RAudioBuffer Integer
_rAudioBuffer'sizeInFrames Integer -> f Integer
f RAudioBuffer
buffer =
    (\Integer
sizeInFrames' -> RAudioBuffer
buffer { RL.rAudioBuffer'sizeInFrames = sizeInFrames' }) (Integer -> RAudioBuffer) -> f Integer -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f (RAudioBuffer -> Integer
RL.rAudioBuffer'sizeInFrames RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'sizeInFrames #-}
_rAudioBuffer'frameCursorPos :: Lens' RL.RAudioBuffer Integer
_rAudioBuffer'frameCursorPos :: Lens' RAudioBuffer Integer
_rAudioBuffer'frameCursorPos Integer -> f Integer
f RAudioBuffer
buffer =
    (\Integer
frameCursorPos' -> RAudioBuffer
buffer { RL.rAudioBuffer'frameCursorPos = frameCursorPos' }) (Integer -> RAudioBuffer) -> f Integer -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f (RAudioBuffer -> Integer
RL.rAudioBuffer'frameCursorPos RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'frameCursorPos #-}
_rAudioBuffer'framesProcessed :: Lens' RL.RAudioBuffer Integer
_rAudioBuffer'framesProcessed :: Lens' RAudioBuffer Integer
_rAudioBuffer'framesProcessed Integer -> f Integer
f RAudioBuffer
buffer =
    (\Integer
framesProcessed' -> RAudioBuffer
buffer { RL.rAudioBuffer'framesProcessed = framesProcessed' }) (Integer -> RAudioBuffer) -> f Integer -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f (RAudioBuffer -> Integer
RL.rAudioBuffer'framesProcessed RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'framesProcessed #-}
_rAudioBuffer'data :: Lens' RL.RAudioBuffer [Word8]
_rAudioBuffer'data :: Lens' RAudioBuffer [Word8]
_rAudioBuffer'data [Word8] -> f [Word8]
f RAudioBuffer
buffer =
    (\[Word8]
data' -> RAudioBuffer
buffer { RL.rAudioBuffer'data = data' }) ([Word8] -> RAudioBuffer) -> f [Word8] -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Word8] -> f [Word8]
f (RAudioBuffer -> [Word8]
RL.rAudioBuffer'data RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'data #-}
_rAudioBuffer'next :: Lens' RL.RAudioBuffer (Maybe RL.RAudioBuffer)
_rAudioBuffer'next :: Lens' RAudioBuffer (Maybe RAudioBuffer)
_rAudioBuffer'next Maybe RAudioBuffer -> f (Maybe RAudioBuffer)
f RAudioBuffer
buffer =
    (\Maybe RAudioBuffer
next' -> RAudioBuffer
buffer { RL.rAudioBuffer'next = next' }) (Maybe RAudioBuffer -> RAudioBuffer)
-> f (Maybe RAudioBuffer) -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe RAudioBuffer -> f (Maybe RAudioBuffer)
f (RAudioBuffer -> Maybe RAudioBuffer
RL.rAudioBuffer'next RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'next #-}
_rAudioBuffer'prev :: Lens' RL.RAudioBuffer (Maybe RL.RAudioBuffer)
_rAudioBuffer'prev :: Lens' RAudioBuffer (Maybe RAudioBuffer)
_rAudioBuffer'prev Maybe RAudioBuffer -> f (Maybe RAudioBuffer)
f RAudioBuffer
buffer =
    (\Maybe RAudioBuffer
prev' -> RAudioBuffer
buffer { RL.rAudioBuffer'prev = prev' }) (Maybe RAudioBuffer -> RAudioBuffer)
-> f (Maybe RAudioBuffer) -> f RAudioBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe RAudioBuffer -> f (Maybe RAudioBuffer)
f (RAudioBuffer -> Maybe RAudioBuffer
RL.rAudioBuffer'prev RAudioBuffer
buffer)
{-# INLINE _rAudioBuffer'prev #-}


_rAudioProcessor'process :: Lens' RL.RAudioProcessor (Maybe RL.AudioCallback)
_rAudioProcessor'process :: Lens' RAudioProcessor (Maybe AudioCallback)
_rAudioProcessor'process Maybe AudioCallback -> f (Maybe AudioCallback)
f (RL.RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next Maybe RAudioProcessor
prev) =
    (\Maybe AudioCallback
process' -> Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RL.RAudioProcessor Maybe AudioCallback
process' Maybe RAudioProcessor
next Maybe RAudioProcessor
prev) (Maybe AudioCallback -> RAudioProcessor)
-> f (Maybe AudioCallback) -> f RAudioProcessor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AudioCallback -> f (Maybe AudioCallback)
f Maybe AudioCallback
process
{-# INLINE _rAudioProcessor'process #-}
_rAudioProcessor'next :: Lens' RL.RAudioProcessor (Maybe RL.RAudioProcessor)
_rAudioProcessor'next :: Lens' RAudioProcessor (Maybe RAudioProcessor)
_rAudioProcessor'next Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f (RL.RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next Maybe RAudioProcessor
prev) =
    (\Maybe RAudioProcessor
next' -> Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RL.RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next' Maybe RAudioProcessor
prev) (Maybe RAudioProcessor -> RAudioProcessor)
-> f (Maybe RAudioProcessor) -> f RAudioProcessor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f Maybe RAudioProcessor
next
{-# INLINE _rAudioProcessor'next #-}
_rAudioProcessor'prev :: Lens' RL.RAudioProcessor (Maybe RL.RAudioProcessor)
_rAudioProcessor'prev :: Lens' RAudioProcessor (Maybe RAudioProcessor)
_rAudioProcessor'prev Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f (RL.RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next Maybe RAudioProcessor
prev) =
    (\Maybe RAudioProcessor
prev' -> Maybe AudioCallback
-> Maybe RAudioProcessor
-> Maybe RAudioProcessor
-> RAudioProcessor
RL.RAudioProcessor Maybe AudioCallback
process Maybe RAudioProcessor
next Maybe RAudioProcessor
prev') (Maybe RAudioProcessor -> RAudioProcessor)
-> f (Maybe RAudioProcessor) -> f RAudioProcessor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RAudioProcessor -> f (Maybe RAudioProcessor)
f Maybe RAudioProcessor
prev
{-# INLINE _rAudioProcessor'prev #-}


_AudioStream'buffer :: Lens' RL.AudioStream (Ptr RL.RAudioBuffer)
_AudioStream'buffer :: Lens' AudioStream (Ptr RAudioBuffer)
_AudioStream'buffer Ptr RAudioBuffer -> f (Ptr RAudioBuffer)
f (RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) =
    (\Ptr RAudioBuffer
buffer' -> Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
RL.AudioStream Ptr RAudioBuffer
buffer' Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) (Ptr RAudioBuffer -> AudioStream)
-> f (Ptr RAudioBuffer) -> f AudioStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Ptr RAudioBuffer -> f (Ptr RAudioBuffer)
f Ptr RAudioBuffer
buffer
{-# INLINE _AudioStream'buffer#-}
_AudioStream'processor :: Lens' RL.AudioStream (Ptr RL.RAudioProcessor)
_AudioStream'processor :: Lens' AudioStream (Ptr RAudioProcessor)
_AudioStream'processor Ptr RAudioProcessor -> f (Ptr RAudioProcessor)
f (RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) =
    (\Ptr RAudioProcessor
processor' -> Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor' Integer
sampleRate Integer
sampleSize Integer
channels) (Ptr RAudioProcessor -> AudioStream)
-> f (Ptr RAudioProcessor) -> f AudioStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Ptr RAudioProcessor -> f (Ptr RAudioProcessor)
f Ptr RAudioProcessor
processor
{-# INLINE _AudioStream'processor #-}
_AudioStream'sampleRate :: Lens' RL.AudioStream Integer
_AudioStream'sampleRate :: Lens' AudioStream Integer
_AudioStream'sampleRate Integer -> f Integer
f (RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) =
    (\Integer
sampleRate' -> Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate' Integer
sampleSize Integer
channels) (Integer -> AudioStream) -> f Integer -> f AudioStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f Integer
sampleRate
{-# INLINE _AudioStream'sampleRate #-}
_AudioStream'sampleSize :: Lens' RL.AudioStream Integer
_AudioStream'sampleSize :: Lens' AudioStream Integer
_AudioStream'sampleSize Integer -> f Integer
f (RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) =
    (\Integer
sampleSize' -> Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize' Integer
channels) (Integer -> AudioStream) -> f Integer -> f AudioStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f Integer
sampleSize
{-# INLINE _AudioStream'sampleSize #-}
_AudioStream'channels :: Lens' RL.AudioStream Integer
_AudioStream'channels :: Lens' AudioStream Integer
_AudioStream'channels Integer -> f Integer
f (RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels) =
    (\Integer
channels' -> Ptr RAudioBuffer
-> Ptr RAudioProcessor
-> Integer
-> Integer
-> Integer
-> AudioStream
RL.AudioStream Ptr RAudioBuffer
buffer Ptr RAudioProcessor
processor Integer
sampleRate Integer
sampleSize Integer
channels') (Integer -> AudioStream) -> f Integer -> f AudioStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f Integer
channels
{-# INLINE _AudioStream'channels #-}


_sound'stream :: Lens' RL.Sound RL.AudioStream
_sound'stream :: Lens' Sound AudioStream
_sound'stream AudioStream -> f AudioStream
f (RL.Sound AudioStream
stream Integer
frameCount) = (\AudioStream
stream' -> AudioStream -> Integer -> Sound
RL.Sound AudioStream
stream' Integer
frameCount) (AudioStream -> Sound) -> f AudioStream -> f Sound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioStream -> f AudioStream
f AudioStream
stream
{-# INLINE _sound'stream #-}
_sound'frameCount :: Lens' RL.Sound Integer
_sound'frameCount :: Lens' Sound Integer
_sound'frameCount Integer -> f Integer
f (RL.Sound AudioStream
stream Integer
frameCount) = (\Integer
frameCount' -> AudioStream -> Integer -> Sound
RL.Sound AudioStream
stream Integer
frameCount') (Integer -> Sound) -> f Integer -> f Sound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
frameCount
{-# INLINE _sound'frameCount #-}


_music'stream :: Lens' RL.Music RL.AudioStream
_music'stream :: Lens' Music AudioStream
_music'stream AudioStream -> f AudioStream
f (RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) =
    (\AudioStream
stream' -> AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
RL.Music AudioStream
stream' Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) (AudioStream -> Music) -> f AudioStream -> f Music
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    AudioStream -> f AudioStream
f AudioStream
stream
{-# INLINE _music'stream #-}
_music'frameCount :: Lens' RL.Music Integer
_music'frameCount :: Lens' Music Integer
_music'frameCount Integer -> f Integer
f (RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) =
    (\Integer
frameCount' -> AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
RL.Music AudioStream
stream Integer
frameCount' Bool
looping MusicContextType
ctxType Ptr ()
ctxData) (Integer -> Music) -> f Integer -> f Music
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f Integer
frameCount
{-# INLINE _music'frameCount #-}
_music'looping :: Lens' RL.Music Bool
_music'looping :: Lens' Music Bool
_music'looping Bool -> f Bool
f (RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) =
    (\Bool
looping' -> AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
RL.Music AudioStream
stream Integer
frameCount Bool
looping' MusicContextType
ctxType Ptr ()
ctxData) (Bool -> Music) -> f Bool -> f Music
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Bool -> f Bool
f Bool
looping
{-# INLINE _music'looping #-}
_music'ctxType :: Lens' RL.Music RL.MusicContextType
_music'ctxType :: Lens' Music MusicContextType
_music'ctxType MusicContextType -> f MusicContextType
f (RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) =
    (\MusicContextType
ctxType' -> AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType' Ptr ()
ctxData) (MusicContextType -> Music) -> f MusicContextType -> f Music
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    MusicContextType -> f MusicContextType
f MusicContextType
ctxType
{-# INLINE _music'ctxType #-}
_music'ctxData :: Lens' RL.Music (Ptr ())
_music'ctxData :: Lens' Music (Ptr ())
_music'ctxData Ptr () -> f (Ptr ())
f (RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData) =
    (\Ptr ()
ctxData' -> AudioStream
-> Integer -> Bool -> MusicContextType -> Ptr () -> Music
RL.Music AudioStream
stream Integer
frameCount Bool
looping MusicContextType
ctxType Ptr ()
ctxData') (Ptr () -> Music) -> f (Ptr ()) -> f Music
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Ptr () -> f (Ptr ())
f Ptr ()
ctxData
{-# INLINE _music'ctxData #-}


_vrDeviceInfo'hResolution :: Lens' RL.VrDeviceInfo Int
_vrDeviceInfo'hResolution :: Lens' VrDeviceInfo Int
_vrDeviceInfo'hResolution Int -> f Int
f VrDeviceInfo
device =
    (\Int
hResolution' -> VrDeviceInfo
device { RL.vrDeviceInfo'hResolution = hResolution' }) (Int -> VrDeviceInfo) -> f Int -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (VrDeviceInfo -> Int
RL.vrDeviceInfo'hResolution VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'hResolution #-}
_vrDeviceInfo'vResolution :: Lens' RL.VrDeviceInfo Int
_vrDeviceInfo'vResolution :: Lens' VrDeviceInfo Int
_vrDeviceInfo'vResolution Int -> f Int
f VrDeviceInfo
device =
    (\Int
vResolution' -> VrDeviceInfo
device { RL.vrDeviceInfo'vResolution = vResolution' }) (Int -> VrDeviceInfo) -> f Int -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (VrDeviceInfo -> Int
RL.vrDeviceInfo'vResolution VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'vResolution #-}
_vrDeviceInfo'hScreenSize :: Lens' RL.VrDeviceInfo Float
_vrDeviceInfo'hScreenSize :: Lens' VrDeviceInfo Float
_vrDeviceInfo'hScreenSize Float -> f Float
f VrDeviceInfo
device =
    (\Float
hScreenSize' -> VrDeviceInfo
device { RL.vrDeviceInfo'hScreenSize = hScreenSize' }) (Float -> VrDeviceInfo) -> f Float -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (VrDeviceInfo -> Float
RL.vrDeviceInfo'hScreenSize VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'hScreenSize #-}
_vrDeviceInfo'vScreenSize :: Lens' RL.VrDeviceInfo Float
_vrDeviceInfo'vScreenSize :: Lens' VrDeviceInfo Float
_vrDeviceInfo'vScreenSize Float -> f Float
f VrDeviceInfo
device =
    (\Float
vScreenSize' -> VrDeviceInfo
device { RL.vrDeviceInfo'vScreenSize = vScreenSize' }) (Float -> VrDeviceInfo) -> f Float -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (VrDeviceInfo -> Float
RL.vrDeviceInfo'vScreenSize VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'vScreenSize #-}
_vrDeviceInfo'eyeToScreenDistance :: Lens' RL.VrDeviceInfo Float
_vrDeviceInfo'eyeToScreenDistance :: Lens' VrDeviceInfo Float
_vrDeviceInfo'eyeToScreenDistance Float -> f Float
f VrDeviceInfo
device =
    (\Float
eyeToScreenDistance' -> VrDeviceInfo
device { RL.vrDeviceInfo'eyeToScreenDistance = eyeToScreenDistance' }) (Float -> VrDeviceInfo) -> f Float -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (VrDeviceInfo -> Float
RL.vrDeviceInfo'eyeToScreenDistance VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'eyeToScreenDistance #-}
_vrDeviceInfo'lensSeparationDistance :: Lens' RL.VrDeviceInfo Float
_vrDeviceInfo'lensSeparationDistance :: Lens' VrDeviceInfo Float
_vrDeviceInfo'lensSeparationDistance Float -> f Float
f VrDeviceInfo
device =
    (\Float
lensSeparationDistance' -> VrDeviceInfo
device { RL.vrDeviceInfo'lensSeparationDistance = lensSeparationDistance' }) (Float -> VrDeviceInfo) -> f Float -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (VrDeviceInfo -> Float
RL.vrDeviceInfo'lensSeparationDistance VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'lensSeparationDistance #-}
_vrDeviceInfo'interpupillaryDistance :: Lens' RL.VrDeviceInfo Float
_vrDeviceInfo'interpupillaryDistance :: Lens' VrDeviceInfo Float
_vrDeviceInfo'interpupillaryDistance Float -> f Float
f VrDeviceInfo
device =
    (\Float
interpupillaryDistance' -> VrDeviceInfo
device { RL.vrDeviceInfo'interpupillaryDistance = interpupillaryDistance' }) (Float -> VrDeviceInfo) -> f Float -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f (VrDeviceInfo -> Float
RL.vrDeviceInfo'interpupillaryDistance VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'interpupillaryDistance #-}
_vrDeviceInfo'lensDistortionValues :: Lens' RL.VrDeviceInfo [Float]
_vrDeviceInfo'lensDistortionValues :: Lens' VrDeviceInfo [Float]
_vrDeviceInfo'lensDistortionValues [Float] -> f [Float]
f VrDeviceInfo
device =
    (\[Float]
lensDistortionValues' -> VrDeviceInfo
device { RL.vrDeviceInfo'lensDistortionValues = lensDistortionValues' }) ([Float] -> VrDeviceInfo) -> f [Float] -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrDeviceInfo -> [Float]
RL.vrDeviceInfo'lensDistortionValues VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'lensDistortionValues #-}
_vrDeviceInfo'chromaAbCorrection :: Lens' RL.VrDeviceInfo [Float]
_vrDeviceInfo'chromaAbCorrection :: Lens' VrDeviceInfo [Float]
_vrDeviceInfo'chromaAbCorrection [Float] -> f [Float]
f VrDeviceInfo
device =
    (\[Float]
chromaAbCorrection' -> VrDeviceInfo
device { RL.vrDeviceInfo'chromaAbCorrection = chromaAbCorrection' }) ([Float] -> VrDeviceInfo) -> f [Float] -> f VrDeviceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrDeviceInfo -> [Float]
RL.vrDeviceInfo'chromaAbCorrection VrDeviceInfo
device)
{-# INLINE _vrDeviceInfo'chromaAbCorrection #-}


_vrStereoConfig'projection :: Lens' RL.VrStereoConfig [RL.Matrix]
_vrStereoConfig'projection :: Lens' VrStereoConfig [Matrix]
_vrStereoConfig'projection [Matrix] -> f [Matrix]
f VrStereoConfig
config =
    (\[Matrix]
projection' -> VrStereoConfig
config { RL.vrStereoConfig'projection = projection' }) ([Matrix] -> VrStereoConfig) -> f [Matrix] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Matrix] -> f [Matrix]
f (VrStereoConfig -> [Matrix]
RL.vrStereoConfig'projection VrStereoConfig
config)
{-# INLINE _vrStereoConfig'projection #-}
_vrStereoConfig'viewOffset :: Lens' RL.VrStereoConfig [RL.Matrix]
_vrStereoConfig'viewOffset :: Lens' VrStereoConfig [Matrix]
_vrStereoConfig'viewOffset [Matrix] -> f [Matrix]
f VrStereoConfig
config =
    (\[Matrix]
viewOffset' -> VrStereoConfig
config { RL.vrStereoConfig'viewOffset = viewOffset' }) ([Matrix] -> VrStereoConfig) -> f [Matrix] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Matrix] -> f [Matrix]
f (VrStereoConfig -> [Matrix]
RL.vrStereoConfig'viewOffset VrStereoConfig
config)
{-# INLINE _vrStereoConfig'viewOffset #-}
_vrStereoConfig'leftLensCenter :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'leftLensCenter :: Lens' VrStereoConfig [Float]
_vrStereoConfig'leftLensCenter [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
leftLensCenter' -> VrStereoConfig
config { RL.vrStereoConfig'leftLensCenter = leftLensCenter' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'leftLensCenter VrStereoConfig
config)
{-# INLINE _vrStereoConfig'leftLensCenter #-}
_vrStereoConfig'rightLensCenter :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'rightLensCenter :: Lens' VrStereoConfig [Float]
_vrStereoConfig'rightLensCenter [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
rightLensCenter' -> VrStereoConfig
config { RL.vrStereoConfig'rightLensCenter = rightLensCenter' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'rightLensCenter VrStereoConfig
config)
{-# INLINE _vrStereoConfig'rightLensCenter #-}
_vrStereoConfig'leftScreenCenter :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'leftScreenCenter :: Lens' VrStereoConfig [Float]
_vrStereoConfig'leftScreenCenter [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
leftScreenCenter' -> VrStereoConfig
config { RL.vrStereoConfig'leftScreenCenter = leftScreenCenter' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'leftScreenCenter VrStereoConfig
config)
{-# INLINE _vrStereoConfig'leftScreenCenter #-}
_vrStereoConfig'rightScreenCenter :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'rightScreenCenter :: Lens' VrStereoConfig [Float]
_vrStereoConfig'rightScreenCenter [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
rightScreenCenter' -> VrStereoConfig
config { RL.vrStereoConfig'rightScreenCenter = rightScreenCenter' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'rightScreenCenter VrStereoConfig
config)
{-# INLINE _vrStereoConfig'rightScreenCenter #-}
_vrStereoConfig'scale :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'scale :: Lens' VrStereoConfig [Float]
_vrStereoConfig'scale [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
scale' -> VrStereoConfig
config { RL.vrStereoConfig'scale = scale' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'scale VrStereoConfig
config)
{-# INLINE _vrStereoConfig'scale #-}
_vrStereoConfig'scaleIn :: Lens' RL.VrStereoConfig [Float]
_vrStereoConfig'scaleIn :: Lens' VrStereoConfig [Float]
_vrStereoConfig'scaleIn [Float] -> f [Float]
f VrStereoConfig
config =
    (\[Float]
scaleIn' -> VrStereoConfig
config { RL.vrStereoConfig'scaleIn = scaleIn' }) ([Float] -> VrStereoConfig) -> f [Float] -> f VrStereoConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Float] -> f [Float]
f (VrStereoConfig -> [Float]
RL.vrStereoConfig'scaleIn VrStereoConfig
config)
{-# INLINE _vrStereoConfig'scaleIn #-}


_filePathList'capacity :: Lens' RL.FilePathList Integer
_filePathList'capacity :: Lens' FilePathList Integer
_filePathList'capacity Integer -> f Integer
f (RL.FilePathList Integer
capacity [String]
paths) =
    (\Integer
capacity' -> Integer -> [String] -> FilePathList
RL.FilePathList Integer
capacity' [String]
paths) (Integer -> FilePathList) -> f Integer -> f FilePathList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
capacity
{-# INLINE _filePathList'capacity #-}
_filePathList'paths :: Lens' RL.FilePathList [String]
_filePathList'paths :: Lens' FilePathList [String]
_filePathList'paths [String] -> f [String]
f (RL.FilePathList Integer
capacity [String]
paths) =
    (\[String]
paths' -> Integer -> [String] -> FilePathList
RL.FilePathList Integer
capacity [String]
paths') ([String] -> FilePathList) -> f [String] -> f FilePathList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> f [String]
f [String]
paths
{-# INLINE _filePathList'paths #-}

_automationEvent'frame :: Lens' RL.AutomationEvent Integer
_automationEvent'frame :: Lens' AutomationEvent Integer
_automationEvent'frame Integer -> f Integer
f (RL.AutomationEvent Integer
frame Integer
_type [Int]
params) =
    (\Integer
frame' -> Integer -> Integer -> [Int] -> AutomationEvent
RL.AutomationEvent Integer
frame' Integer
_type [Int]
params) (Integer -> AutomationEvent) -> f Integer -> f AutomationEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
frame
{-# INLINE _automationEvent'frame #-}

_automationEvent'type :: Lens' RL.AutomationEvent Integer
_automationEvent'type :: Lens' AutomationEvent Integer
_automationEvent'type Integer -> f Integer
f (RL.AutomationEvent Integer
frame Integer
_type [Int]
params) =
    (\Integer
type' -> Integer -> Integer -> [Int] -> AutomationEvent
RL.AutomationEvent Integer
frame Integer
type' [Int]
params) (Integer -> AutomationEvent) -> f Integer -> f AutomationEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
_type
{-# INLINE _automationEvent'type #-}

_automationEvent'params :: Lens' RL.AutomationEvent [Int]
_automationEvent'params :: Lens' AutomationEvent [Int]
_automationEvent'params [Int] -> f [Int]
f (RL.AutomationEvent Integer
frame Integer
_type [Int]
params) =
    (\[Int]
params' -> Integer -> Integer -> [Int] -> AutomationEvent
RL.AutomationEvent Integer
frame Integer
_type [Int]
params') ([Int] -> AutomationEvent) -> f [Int] -> f AutomationEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> f [Int]
f [Int]
params
{-# INLINE _automationEvent'params #-}

_automationEventList'capacity :: Lens' RL.AutomationEventList Integer
_automationEventList'capacity :: Lens' AutomationEventList Integer
_automationEventList'capacity Integer -> f Integer
f (RL.AutomationEventList Integer
capacity [AutomationEvent]
events) =
    (\Integer
capacity' -> Integer -> [AutomationEvent] -> AutomationEventList
RL.AutomationEventList Integer
capacity' [AutomationEvent]
events) (Integer -> AutomationEventList)
-> f Integer -> f AutomationEventList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
f Integer
capacity
{-# INLINE _automationEventList'capacity #-}

_automationEventList'events :: Lens' RL.AutomationEventList [RL.AutomationEvent]
_automationEventList'events :: Lens' AutomationEventList [AutomationEvent]
_automationEventList'events [AutomationEvent] -> f [AutomationEvent]
f (RL.AutomationEventList Integer
capacity [AutomationEvent]
events) =
    (\[AutomationEvent]
events' -> Integer -> [AutomationEvent] -> AutomationEventList
RL.AutomationEventList Integer
capacity [AutomationEvent]
events') ([AutomationEvent] -> AutomationEventList)
-> f [AutomationEvent] -> f AutomationEventList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AutomationEvent] -> f [AutomationEvent]
f [AutomationEvent]
events
{-# INLINE _automationEventList'events #-}

_rlVertexBuffer'elementCount :: Lens' RL.RLVertexBuffer Int
_rlVertexBuffer'elementCount :: Lens' RLVertexBuffer Int
_rlVertexBuffer'elementCount Int -> f Int
f RLVertexBuffer
buffer =
    (\Int
elementCount' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'elementCount = elementCount' }) (Int -> RLVertexBuffer) -> f Int -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f (RLVertexBuffer -> Int
RL.rlVertexBuffer'elementCount RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'elementCount #-}
_rlVertexBuffer'vertices :: Lens' RL.RLVertexBuffer [RL.Vector3]
_rlVertexBuffer'vertices :: Lens' RLVertexBuffer [Vector3]
_rlVertexBuffer'vertices [Vector3] -> f [Vector3]
f RLVertexBuffer
buffer =
    (\[Vector3]
vertices' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'vertices = vertices' }) ([Vector3] -> RLVertexBuffer) -> f [Vector3] -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Vector3] -> f [Vector3]
f (RLVertexBuffer -> [Vector3]
RL.rlVertexBuffer'vertices RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'vertices #-}
_rlVertexBuffer'texcoords :: Lens' RL.RLVertexBuffer [RL.Vector2]
_rlVertexBuffer'texcoords :: Lens' RLVertexBuffer [Vector2]
_rlVertexBuffer'texcoords [Vector2] -> f [Vector2]
f RLVertexBuffer
buffer =
    (\[Vector2]
texcoords' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'texcoords = texcoords' }) ([Vector2] -> RLVertexBuffer) -> f [Vector2] -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Vector2] -> f [Vector2]
f (RLVertexBuffer -> [Vector2]
RL.rlVertexBuffer'texcoords RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'texcoords #-}
_rlVertexBuffer'colors :: Lens' RL.RLVertexBuffer [RL.Color]
_rlVertexBuffer'colors :: Lens' RLVertexBuffer [Color]
_rlVertexBuffer'colors [Color] -> f [Color]
f RLVertexBuffer
buffer =
    (\[Color]
colors' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'colors = colors' }) ([Color] -> RLVertexBuffer) -> f [Color] -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Color] -> f [Color]
f (RLVertexBuffer -> [Color]
RL.rlVertexBuffer'colors RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'colors #-}
_rlVertexBuffer'indices :: Lens' RL.RLVertexBuffer [Integer]
_rlVertexBuffer'indices :: Lens' RLVertexBuffer [Integer]
_rlVertexBuffer'indices [Integer] -> f [Integer]
f RLVertexBuffer
buffer =
    (\[Integer]
indices' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'indices = indices' }) ([Integer] -> RLVertexBuffer) -> f [Integer] -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Integer] -> f [Integer]
f (RLVertexBuffer -> [Integer]
RL.rlVertexBuffer'indices RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'indices #-}
_rlVertexBuffer'vaoId :: Lens' RL.RLVertexBuffer Integer
_rlVertexBuffer'vaoId :: Lens' RLVertexBuffer Integer
_rlVertexBuffer'vaoId Integer -> f Integer
f RLVertexBuffer
buffer =
    (\Integer
vaoId' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'vaoId = vaoId' }) (Integer -> RLVertexBuffer) -> f Integer -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f (RLVertexBuffer -> Integer
RL.rlVertexBuffer'vaoId RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'vaoId #-}
_rlVertexBuffer'vboId :: Lens' RL.RLVertexBuffer [Integer]
_rlVertexBuffer'vboId :: Lens' RLVertexBuffer [Integer]
_rlVertexBuffer'vboId [Integer] -> f [Integer]
f RLVertexBuffer
buffer =
    (\[Integer]
vboId' -> RLVertexBuffer
buffer { RL.rlVertexBuffer'vboId = vboId' }) ([Integer] -> RLVertexBuffer) -> f [Integer] -> f RLVertexBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Integer] -> f [Integer]
f (RLVertexBuffer -> [Integer]
RL.rlVertexBuffer'vboId RLVertexBuffer
buffer)
{-# INLINE _rlVertexBuffer'vboId #-}


_rlDrawCall'mode :: Lens' RL.RLDrawCall RL.RLDrawMode
_rlDrawCall'mode :: Lens' RLDrawCall RLDrawMode
_rlDrawCall'mode RLDrawMode -> f RLDrawMode
f (RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId) =
    (\RLDrawMode
mode' -> RLDrawMode -> Int -> Int -> Integer -> RLDrawCall
RL.RLDrawCall RLDrawMode
mode' Int
vertexCount Int
vertexAlignment Integer
textureId) (RLDrawMode -> RLDrawCall) -> f RLDrawMode -> f RLDrawCall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    RLDrawMode -> f RLDrawMode
f RLDrawMode
mode
{-# INLINE _rlDrawCall'mode #-}
_rlDrawCall'vertexCount :: Lens' RL.RLDrawCall Int
_rlDrawCall'vertexCount :: Lens' RLDrawCall Int
_rlDrawCall'vertexCount Int -> f Int
f (RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId) =
    (\Int
vertexCount' -> RLDrawMode -> Int -> Int -> Integer -> RLDrawCall
RL.RLDrawCall RLDrawMode
mode Int
vertexCount' Int
vertexAlignment Integer
textureId) (Int -> RLDrawCall) -> f Int -> f RLDrawCall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f Int
vertexCount
{-# INLINE _rlDrawCall'vertexCount #-}
_rlDrawCall'vertexAlignment :: Lens' RL.RLDrawCall Int
_rlDrawCall'vertexAlignment :: Lens' RLDrawCall Int
_rlDrawCall'vertexAlignment Int -> f Int
f (RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId) =
    (\Int
vertexAlignment' -> RLDrawMode -> Int -> Int -> Integer -> RLDrawCall
RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment' Integer
textureId) (Int -> RLDrawCall) -> f Int -> f RLDrawCall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f Int
vertexAlignment
{-# INLINE _rlDrawCall'vertexAlignment #-}
_rlDrawCall'textureId :: Lens' RL.RLDrawCall Integer
_rlDrawCall'textureId :: Lens' RLDrawCall Integer
_rlDrawCall'textureId Integer -> f Integer
f (RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId) =
    (\Integer
textureId' -> RLDrawMode -> Int -> Int -> Integer -> RLDrawCall
RL.RLDrawCall RLDrawMode
mode Int
vertexCount Int
vertexAlignment Integer
textureId') (Integer -> RLDrawCall) -> f Integer -> f RLDrawCall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> f Integer
f Integer
textureId
{-# INLINE _rlDrawCall'textureId #-}


_rlRenderBatch'bufferCount :: Lens' RL.RLRenderBatch Int
_rlRenderBatch'bufferCount :: Lens' RLRenderBatch Int
_rlRenderBatch'bufferCount Int -> f Int
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\Int
bufferCount' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount' Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) (Int -> RLRenderBatch) -> f Int -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f Int
bufferCount
{-# INLINE _rlRenderBatch'bufferCount #-}
_rlRenderBatch'currentBuffer :: Lens' RL.RLRenderBatch Int
_rlRenderBatch'currentBuffer :: Lens' RLRenderBatch Int
_rlRenderBatch'currentBuffer Int -> f Int
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\Int
currentBuffer' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount Int
currentBuffer' [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) (Int -> RLRenderBatch) -> f Int -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f Int
currentBuffer
{-# INLINE _rlRenderBatch'currentBuffer #-}
_rlRenderBatch'vertexBuffers :: Lens' RL.RLRenderBatch [RL.RLVertexBuffer]
_rlRenderBatch'vertexBuffers :: Lens' RLRenderBatch [RLVertexBuffer]
_rlRenderBatch'vertexBuffers [RLVertexBuffer] -> f [RLVertexBuffer]
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\[RLVertexBuffer]
vertexBuffers' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers' [RLDrawCall]
draws Int
drawCounter Float
currentDepth) ([RLVertexBuffer] -> RLRenderBatch)
-> f [RLVertexBuffer] -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [RLVertexBuffer] -> f [RLVertexBuffer]
f [RLVertexBuffer]
vertexBuffers
{-# INLINE _rlRenderBatch'vertexBuffers #-}
_rlRenderBatch'draws :: Lens' RL.RLRenderBatch [RL.RLDrawCall]
_rlRenderBatch'draws :: Lens' RLRenderBatch [RLDrawCall]
_rlRenderBatch'draws [RLDrawCall] -> f [RLDrawCall]
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\[RLDrawCall]
draws' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws' Int
drawCounter Float
currentDepth) ([RLDrawCall] -> RLRenderBatch)
-> f [RLDrawCall] -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [RLDrawCall] -> f [RLDrawCall]
f [RLDrawCall]
draws
{-# INLINE _rlRenderBatch'draws #-}
_rlRenderBatch'drawCounter :: Lens' RL.RLRenderBatch Int
_rlRenderBatch'drawCounter :: Lens' RLRenderBatch Int
_rlRenderBatch'drawCounter Int -> f Int
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\Int
drawCounter' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter' Float
currentDepth) (Int -> RLRenderBatch) -> f Int -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> f Int
f Int
drawCounter
{-# INLINE _rlRenderBatch'drawCounter #-}
_rlRenderBatch'currentDepth :: Lens' RL.RLRenderBatch Float
_rlRenderBatch'currentDepth :: Lens' RLRenderBatch Float
_rlRenderBatch'currentDepth Float -> f Float
f (RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth) =
    (\Float
currentDepth' -> Int
-> Int
-> [RLVertexBuffer]
-> [RLDrawCall]
-> Int
-> Float
-> RLRenderBatch
RL.RLRenderBatch Int
bufferCount Int
currentBuffer [RLVertexBuffer]
vertexBuffers [RLDrawCall]
draws Int
drawCounter Float
currentDepth') (Float -> RLRenderBatch) -> f Float -> f RLRenderBatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Float -> f Float
f Float
currentDepth
{-# INLINE _rlRenderBatch'currentDepth #-}