{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Lenses for raylib types
module Raylib.Util.Lenses where

import Control.Lens (Lens', lens)
import Raylib.Internal.TH (genLenses)
import qualified Raylib.Types as RL

$( genLenses
     [ -- Raylib.Types.Core
       ''RL.Matrix,
       ''RL.Color,
       ''RL.Rectangle,
       ''RL.VrDeviceInfo,
       ''RL.VrStereoConfig,
       ''RL.FilePathList,
       ''RL.AutomationEvent,
       ''RL.AutomationEventList,
       -- Raylib.Types.Core.Audio
       ''RL.Wave,
       ''RL.RAudioBuffer,
       ''RL.RAudioProcessor,
       ''RL.AudioStream,
       ''RL.Sound,
       ''RL.Music,
       -- Raylib.Types.Core.Camera
       ''RL.Camera3D,
       ''RL.Camera2D,
       -- Raylib.Types.Core.Models
       ''RL.Mesh,
       ''RL.Shader,
       ''RL.MaterialMap,
       ''RL.Material,
       ''RL.Transform,
       ''RL.BoneInfo,
       ''RL.Model,
       ''RL.ModelAnimation,
       ''RL.Ray,
       ''RL.RayCollision,
       ''RL.BoundingBox,
       -- Raylib.Types.Core.Text
       ''RL.GlyphInfo,
       ''RL.Font,
       -- Raylib.Types.Core.Textures
       ''RL.Image,
       ''RL.Texture,
       ''RL.RenderTexture,
       ''RL.NPatchInfo,
       -- Raylib.Types.Util.RLGL
       ''RL.RLVertexBuffer,
       ''RL.RLDrawCall,
       ''RL.RLRenderBatch,
       -- Raylib.Types.Util.GUI
       ''RL.GuiStyleProp
     ]
 )

_vector2'x :: Lens' RL.Vector2 Float
_vector2'x :: Lens' Vector2 Float
_vector2'x = (Vector2 -> Float)
-> (Vector2 -> Float -> Vector2) -> Lens' Vector2 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector2 -> Float
RL.vector2'x (\Vector2
x Float
v -> Vector2
x {RL.vector2'x = v})

_vector2'y :: Lens' RL.Vector2 Float
_vector2'y :: Lens' Vector2 Float
_vector2'y = (Vector2 -> Float)
-> (Vector2 -> Float -> Vector2) -> Lens' Vector2 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector2 -> Float
RL.vector2'y (\Vector2
x Float
v -> Vector2
x {RL.vector2'y = v})

_vector3'x :: Lens' RL.Vector3 Float
_vector3'x :: Lens' Vector3 Float
_vector3'x = (Vector3 -> Float)
-> (Vector3 -> Float -> Vector3) -> Lens' Vector3 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector3 -> Float
RL.vector3'x (\Vector3
x Float
v -> Vector3
x {RL.vector3'x = v})

_vector3'y :: Lens' RL.Vector3 Float
_vector3'y :: Lens' Vector3 Float
_vector3'y = (Vector3 -> Float)
-> (Vector3 -> Float -> Vector3) -> Lens' Vector3 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector3 -> Float
RL.vector3'y (\Vector3
x Float
v -> Vector3
x {RL.vector3'y = v})

_vector3'z :: Lens' RL.Vector3 Float
_vector3'z :: Lens' Vector3 Float
_vector3'z = (Vector3 -> Float)
-> (Vector3 -> Float -> Vector3) -> Lens' Vector3 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector3 -> Float
RL.vector3'z (\Vector3
x Float
v -> Vector3
x {RL.vector3'z = v})

_vector4'x :: Lens' RL.Vector4 Float
_vector4'x :: Lens' Vector4 Float
_vector4'x = (Vector4 -> Float)
-> (Vector4 -> Float -> Vector4) -> Lens' Vector4 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector4 -> Float
forall a. V4 a -> a
RL.vector4'x (\Vector4
x Float
v -> Vector4
x {RL.vector4'x = v})

_vector4'y :: Lens' RL.Vector4 Float
_vector4'y :: Lens' Vector4 Float
_vector4'y = (Vector4 -> Float)
-> (Vector4 -> Float -> Vector4) -> Lens' Vector4 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector4 -> Float
forall a. V4 a -> a
RL.vector4'y (\Vector4
x Float
v -> Vector4
x {RL.vector4'y = v})

_vector4'z :: Lens' RL.Vector4 Float
_vector4'z :: Lens' Vector4 Float
_vector4'z = (Vector4 -> Float)
-> (Vector4 -> Float -> Vector4) -> Lens' Vector4 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector4 -> Float
forall a. V4 a -> a
RL.vector4'z (\Vector4
x Float
v -> Vector4
x {RL.vector4'z = v})

_vector4'w :: Lens' RL.Vector4 Float
_vector4'w :: Lens' Vector4 Float
_vector4'w = (Vector4 -> Float)
-> (Vector4 -> Float -> Vector4) -> Lens' Vector4 Float
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector4 -> Float
forall a. V4 a -> a
RL.vector4'w (\Vector4
x Float
v -> Vector4
x {RL.vector4'w = v})