0 | {- Tian Z (ecburx@burx.vip) -}
  1 |
  2 | module IdrisGL.SDL.SDL_render
  3 |
  4 | import IdrisGL.DataType
  5 | import IdrisGL.Color
  6 |
  7 | {- FFI -}
  8 |
  9 | frgn : String -> String
 10 | frgn func = "C:" ++ func ++ ",sdl_render"
 11 |
 12 | --
 13 |
 14 | %foreign frgn "createRenderer"
 15 | prim_createRenderer : AnyPtr -> AnyPtr
 16 |
 17 | ||| Create a 2D rendering context for a window.
 18 | export
 19 | createRenderer : HasIO io => Win -> io Renderer
 20 | createRenderer (MkWin win) = pure $ MkRenderer $ prim_createRenderer win
 21 |
 22 | --
 23 |
 24 | %foreign frgn "createTargetTexture"
 25 | prim_createTargetTexture : AnyPtr -> AnyPtr -> AnyPtr
 26 |
 27 | ||| Create a texture as rendering target.
 28 | export
 29 | createTargetTexture : HasIO io => Win -> Renderer -> io Texture
 30 | createTargetTexture (MkWin win) (MkRenderer ren) 
 31 |     = pure $ MkTexture $ prim_createTargetTexture win ren
 32 |
 33 | --
 34 |
 35 | %foreign frgn "setRenderTarget"
 36 | prim_setRenderTarget : AnyPtr -> AnyPtr -> PrimIO ()
 37 |
 38 | ||| Set a texture as the rendering target.
 39 | export
 40 | setRenderTarget : HasIO io => Renderer -> Texture -> io ()
 41 | setRenderTarget (MkRenderer ren) (MkTexture texture)
 42 |     = primIO $ prim_setRenderTarget ren texture
 43 |
 44 | --
 45 |
 46 | %foreign frgn "resetRenderTarget"
 47 | prim_resetRenderTarget : AnyPtr -> PrimIO ()
 48 |
 49 | ||| Reset a null pointer as the rendering target.
 50 | export
 51 | resetRenderTarget : HasIO io => Renderer -> io ()
 52 | resetRenderTarget (MkRenderer ren)
 53 |     = primIO $ prim_resetRenderTarget ren
 54 |
 55 | --
 56 |
 57 | %foreign frgn "setRenderDrawColor"
 58 | prim_setRenderDrawColor : AnyPtr
 59 |                         -> Int -> Int -> Int -> Int
 60 |                         -> PrimIO ()
 61 |
 62 | ||| Set the color used for drawing operations (Rect, Line and Clear).
 63 | export
 64 | setRenderDrawColor : HasIO io => Renderer -> Color -> io ()
 65 | setRenderDrawColor (MkRenderer ren) color
 66 |     = let (r,g,b,a) = rgbaOfColor color in
 67 |       primIO $ prim_setRenderDrawColor ren r g b a
 68 |
 69 | --
 70 |
 71 | %foreign frgn "createTextureFromSur"
 72 | prim_createTextureFromSur : AnyPtr -> AnyPtr -> AnyPtr
 73 |
 74 | ||| Create a texture from surface.
 75 | export
 76 | createTextureFromSur : HasIO io => Renderer -> Sur -> io Texture
 77 | createTextureFromSur (MkRenderer ren) (MkSur sur) 
 78 |     = pure $ MkTexture $ prim_createTextureFromSur ren sur
 79 |
 80 | --
 81 |
 82 | %foreign frgn "renderClear"
 83 | prim_renderClear : AnyPtr -> PrimIO ()
 84 |
 85 | ||| Clear the rendering target with the drawing color.
 86 | export
 87 | renderClear : HasIO io => Renderer -> io ()
 88 | renderClear (MkRenderer ren)
 89 |     = primIO $ prim_renderClear ren
 90 |
 91 | --
 92 |
 93 | %foreign frgn "renderPresent"
 94 | prim_renderPresent : AnyPtr -> PrimIO ()
 95 |
 96 | ||| Update the screen with any rendering performed since the previous call.
 97 | export
 98 | renderPresent : HasIO io => Renderer -> io ()
 99 | renderPresent (MkRenderer ren)
100 |     = primIO $ prim_renderPresent ren
101 |
102 | --
103 |
104 | %foreign frgn "renderCopy"
105 | prim_renderCopy : AnyPtr -> AnyPtr
106 |                 -> Int -> Int -> Int -> Int
107 |                 -> PrimIO ()
108 |
109 | ||| Copy a portion of the texture to the current rendering target.
110 | export
111 | renderCopy : HasIO io => Renderer -> Texture -> Rect -> io ()
112 | renderCopy (MkRenderer ren) (MkTexture t) (MkRect x y w h)
113 |     = primIO $ prim_renderCopy ren t x y w h
114 |
115 | -- 
116 |
117 | %foreign frgn "renderCopyEx"
118 | prim_renderCopyEx : AnyPtr -> AnyPtr
119 |                  -> Int -> Int -> Int -> Int
120 |                  -> Double -> Int -> Int -> Int
121 |                  -> PrimIO ()
122 |
123 | ||| Copy a portion of the texture to the current rendering, with optional rotation and flipping.
124 | ||| @ angle An angle in degrees that indicates the rotation in a clockwise direction.
125 | export
126 | renderCopyEx : HasIO io => Renderer -> Texture -> Rect 
127 |                         -> (angle : Double) -> Coordinate -> FlipSetting
128 |                         -> io ()
129 | renderCopyEx (MkRenderer ren) (MkTexture texture) (MkRect x y w h) angle (MkCoor cx cy) flip
130 |     = primIO $ prim_renderCopyEx ren texture x y w h angle cx cy (flip' flip)
131 |     where flip' : FlipSetting -> Int
132 |           flip' FLIP_NONE       = 0
133 |           flip' FLIP_HORIZONTAL = 1
134 |           flip' FLIP_VERTICAL   = 2
135 |
136 | --
137 |
138 | %foreign frgn "renderCopyExWin"
139 | prim_renderCopyExWin : AnyPtr -> AnyPtr -> AnyPtr
140 |                     -> Double -> Int -> Int -> Int
141 |                     -> PrimIO ()
142 |
143 | ||| Copy a portion of the texture to the current rendering, with optional rotation and flipping.
144 | ||| The difference between it and renderCopyEx is the size has been set to the window size.
145 | ||| @ angle An angle in degrees that indicates the rotation in a clockwise direction.
146 | export
147 | renderCopyExWin : HasIO io => Win -> Renderer -> Texture
148 |                            -> (angle : Double) -> Coordinate -> FlipSetting
149 |                            -> io ()
150 | renderCopyExWin (MkWin win) (MkRenderer ren) (MkTexture texture) angle (MkCoor cx cy) flip
151 |     = primIO $ prim_renderCopyExWin win ren texture angle cx cy (flip' flip)
152 |     where flip' : FlipSetting -> Int
153 |           flip' FLIP_NONE       = 0
154 |           flip' FLIP_HORIZONTAL = 1
155 |           flip' FLIP_VERTICAL   = 2
156 |
157 | --
158 |
159 | %foreign frgn "freeRender"
160 | prim_freeRender : AnyPtr -> PrimIO ()
161 |
162 | ||| Release sources of a renderer.
163 | export
164 | freeRender : HasIO io => Renderer -> io ()
165 | freeRender (MkRenderer ren)
166 |     = primIO $ prim_freeRender ren
167 |
168 | --
169 |
170 | %foreign frgn "renderFillRect"
171 | prim_renderFillRect : AnyPtr
172 |                     -> Int -> Int -> Int -> Int
173 |                     -> Int -> Int -> Int -> Int
174 |                     -> PrimIO ()
175 |
176 | ||| Fill a rectangle on the current rendering target with the drawing color.
177 | export
178 | renderFillRect : HasIO io => Renderer -> Rect -> Color -> io ()
179 | renderFillRect (MkRenderer ren) (MkRect x y w h) color
180 |     = let (r,g,b,a) = rgbaOfColor color in
181 |       primIO $ prim_renderFillRect ren x y w h r g b a
182 |
183 | --
184 |
185 | %foreign frgn "renderDrawRect"
186 | prim_renderDrawRect : AnyPtr
187 |                     -> Int -> Int -> Int -> Int
188 |                     -> Int -> Int -> Int -> Int
189 |                     -> PrimIO ()
190 |
191 | ||| Draw a rectangle on the current rendering target.
192 | export
193 | renderDrawRect : HasIO io => Renderer -> Rect -> Color -> io ()
194 | renderDrawRect (MkRenderer ren) (MkRect x y w h) color
195 |     = let (r,g,b,a) = rgbaOfColor color in
196 |       primIO $ prim_renderDrawRect ren x y w h r g b a
197 |
198 | --
199 |
200 | %foreign frgn "renderDrawLine"
201 | prim_renderDrawLine : AnyPtr
202 |                     -> Int -> Int -> Int -> Int
203 |                     -> Int -> Int -> Int -> Int
204 |                     -> PrimIO ()
205 |
206 | ||| Draw a line on the current rendering target.
207 | export
208 | renderDrawLine : HasIO io => Renderer -> Coordinate -> Coordinate -> Color -> io ()
209 | renderDrawLine (MkRenderer ren) (MkCoor x1 y1) (MkCoor x2 y2) color
210 |     = let (r,g,b,a) = rgbaOfColor color in
211 |       primIO $ prim_renderDrawLine ren x1 y1 x2 y2 r g b a
212 |
213 | -- 
214 |
215 | %foreign frgn "renderDrawPoint"
216 | prim_renderDrawPoint : AnyPtr
217 |                      -> Int -> Int
218 |                      -> Int -> Int -> Int -> Int
219 |                      -> PrimIO ()
220 |
221 | ||| Draw a point on the current rendering target.
222 | export
223 | renderDrawPoint : HasIO io => Renderer -> Coordinate -> Color -> io ()
224 | renderDrawPoint (MkRenderer ren) (MkCoor x y) color
225 |     = let (r,g,b,a) = rgbaOfColor color in
226 |       primIO $ prim_renderDrawPoint ren x y r g b a