Skip to content

Add some docstrings #9

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
david-christiansen wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Add some docstrings #9

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 40 additions & 6 deletions src/Effect/SDL.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,14 @@ import public Graphics.SDL
Srf : Type
Srf = SDLSurface

data Colour = MkCol Int Int Int Int
||| A colour
data Colour : Type where
||| Construct a colour from its components.
||| @ r how much red? (0-255)
||| @ g how much red? (0-255)
||| @ b how much red? (0-255)
||| @ a how much alpha? (0-255)
MkCol : (r, g, b, a : Int) -> Colour

black : Colour
black = MkCol 0 0 0 255
Expand Down Expand Up @@ -46,38 +53,65 @@ instance Handler Sdl IO where

handle s Flip k = do flipBuffers s; k () s
handle s Poll k = do x <- pollEvent; k x s
handle s (WithSurface f) k = do r <- f s; k r s
handle s (WithSurface f) k = do r <- f s; k r s

SDL : Type -> EFFECT
SDL res = MkEff res Sdl

||| A running SDL program
SDL_ON : EFFECT
SDL_ON = SDL SDLSurface

initialise : Int -> Int -> { [SDL ()] ==> [SDL_ON] } Eff ()
||| Initialise the SDL window at some size.
|||
||| @ x the width
||| @ y the height
initialise : (x, y : Int) -> { [SDL ()] ==> [SDL_ON] } Eff ()
initialise x y = call $ Initialise x y

||| Stop the SDL program.
quit : { [SDL_ON] ==> [SDL ()] } Eff ()
quit = call Quit

||| Flip the buffers.
flip : { [SDL_ON] } Eff ()
flip = call Flip

||| Get the current event, if there is one. Don't block.
poll : { [SDL_ON] } Eff (Maybe Event)
poll = call Poll

||| Get ahold of the SDL surface for low-level manipulation.
getSurface : { [SDL_ON] } Eff SDLSurface
getSurface = call $ WithSurface (\s => return s)

rectangle : Colour -> Int -> Int -> Int -> Int -> { [SDL_ON] } Eff ()
||| Draw a rectangle.
|||
||| @ x the horizontal position of the upper-left corner of the rectangle
||| @ y the vertical position of the upper-left corner of the rectangle
||| @ w the width of the rectangle
||| @ h the height of the rectangle
rectangle : Colour -> (x, y : Int) -> (w, h : Int) -> { [SDL_ON] } Eff ()
rectangle (MkCol r g b a) x y w h
= call $ WithSurface (\s => filledRect s x y w h r g b a)

ellipse : Colour -> Int -> Int -> Int -> Int -> { [SDL_ON] } Eff ()
||| Draw an ellipse.
|||
||| @ x the horizontal position of the center of the ellipse
||| @ y the vertical position of the center of the ellipse
||| @ rx the horizontal distance from the center to the edge
||| @ ry the vertical distance from the center to the edge
ellipse : Colour -> (x, y : Int) -> (rx, ry : Int) -> { [SDL_ON] } Eff ()
ellipse (MkCol r g b a) x y rx ry
= call $ WithSurface (\s => filledEllipse s x y rx ry r g b a)

line : Colour -> Int -> Int -> Int -> Int -> { [SDL_ON] } Eff ()
||| Draw a line.
|||
||| @ x the horizontal position of the start of the lin
||| @ y the vertical position of the start of the line
||| @ ex the horizontal position of the end of the lin
||| @ ey the vertical position of the end of the line
line : Colour -> (x, y : Int) -> (ex, ey : Int) -> { [SDL_ON] } Eff ()
line (MkCol r g b a) x y ex ey
= call $ WithSurface (\s => drawLine s x y ex ey r g b a)

Expand Down
44 changes: 37 additions & 7 deletions src/Graphics/SDL.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,19 +9,26 @@ import Graphics.Config

-- Set up a window

abstract
||| A reference to an SDL surface, that is, a window.
abstract
data SDLSurface = MkSurface Ptr

||| Start SDL running in a window.
|||
||| @ x the width of the SDL window.
||| @ y the height of the SDL window.
public
startSDL : Int -> Int -> IO SDLSurface
startSDL : (x, y : Int) -> IO SDLSurface
startSDL x y = do ptr <- do_startSDL
return (MkSurface ptr)
where do_startSDL = mkForeign (FFun "startSDL" [FInt, FInt] FPtr) x y

||| Quit SDL.
public
endSDL : IO ()
endSDL = mkForeign (FFun "SDL_Quit" [] FUnit)

||| Flip the drawing and displayed buffers.
public
flipBuffers : SDLSurface -> IO ();
flipBuffers (MkSurface ptr)
Expand All @@ -30,17 +37,37 @@ flipBuffers (MkSurface ptr)

-- Some drawing primitives

||| Draw a filled rectangle.
||| @ x the horizontal position of the upper-left corner.
||| @ y the vertical position of the upper-left corner.
||| @ w the width of the rectangle.
||| @ r how much red to use (0-255)
||| @ g how much green to use (0-255)
||| @ b how much blue to use (0-255)
||| @ a how much alpha to use (0-255)
public
filledRect : SDLSurface -> Int -> Int -> Int -> Int ->
Int -> Int -> Int -> Int -> IO ()
filledRect : SDLSurface ->
(x, y, w, h, r, g, b, a : Int) ->
IO ()
filledRect (MkSurface ptr) x y w h r g b a
= mkForeign (FFun "filledRect" [FPtr, FInt, FInt, FInt, FInt,
FInt, FInt, FInt, FInt] FUnit)
ptr x y w h r g b a

||| Draw a filled ellipse.
|||
||| @ x the horiontal position of the center
||| @ y the vertical position of the center
||| @ rx the horizontal distance from the center to the edge
||| @ ry the vertical distance from the center to the edge
||| @ r how much red to use (0-255)
||| @ g how much green to use (0-255)
||| @ b how much blue to use (0-255)
||| @ a how much alpha to use (0-255)
public
filledEllipse : SDLSurface -> Int -> Int -> Int -> Int ->
Int -> Int -> Int -> Int -> IO ()
filledEllipse : SDLSurface ->
(x, y, rx, ry, r, g, b, a : Int) ->
IO ()
filledEllipse (MkSurface ptr) x y rx ry r g b a
= mkForeign (FFun "filledEllipse" [FPtr, FInt, FInt, FInt, FInt,
FInt, FInt, FInt, FInt] FUnit)
Expand All @@ -56,7 +83,7 @@ drawLine (MkSurface ptr) x y ex ey r g b a

-- TODO: More keys still to add... careful to do the right mappings in
-- KEY in sdlrun.c

||| SDL keys
public
data Key = KeyUpArrow
| KeyDownArrow
Expand Down Expand Up @@ -120,6 +147,7 @@ instance Eq Key where
(KeyAny x) == (KeyAny y) = x == y
_ == _ = False

||| Mouse button presses
public
data Button = Left | Middle | Right | WheelUp | WheelDown

Expand All @@ -131,6 +159,7 @@ instance Eq Button where
WheelDown == WheelDown = True
_ == _ = False

||| SDL events.
public
data Event = KeyDown Key
| KeyUp Key
Expand All @@ -152,6 +181,7 @@ instance Eq Event where
= b == b' && x == x' && y == y'
_ == _ = False

||| Poll for events.
public
pollEvent : IO (Maybe Event)
pollEvent
Expand Down