Skip to content

Made changes to the tests #16

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
conornewton wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Made changes to the tests #16

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
38 changes: 18 additions & 20 deletions test/etest.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,25 +39,25 @@ Prog i t = Eff t [SDL i,
Running : Type -> Type
Running t = Prog SDLSurface t

initStarfield : List (Int, Int) -> Int -> Eff m [RND] (List (Int, Int))
initStarfield acc 0 = return acc
initStarfield : List (Int, Int) -> Int -> Eff (List (Int, Int)) [RND]
initStarfield acc 0 = pure acc
initStarfield acc n = do x <- rndInt 0 639
y <- rndInt 0 479
initStarfield ((fromInteger x, fromInteger y) :: acc) (n - 1)

updateStarfield : List (Int, Int) -> Eff m [RND] (List (Int, Int))
updateStarfield : List (Int, Int) -> Eff (List (Int, Int)) [RND]
updateStarfield xs = upd [] xs where
upd : List (Int, Int) -> List (Int, Int) -> Eff m [RND] (List (Int, Int))
upd acc [] = return acc
upd : List (Int, Int) -> List (Int, Int) -> Eff (List (Int, Int)) [RND]
upd acc [] = pure acc
upd acc ((x, y) :: xs)
= if (y > 479) then do
x <- rndInt 0 639
upd ((fromInteger x, 0) :: acc) xs
else
upd ((x, y+1) :: acc) xs

drawStarfield : List (Int, Int) -> Eff IO [SDL_ON] ()
drawStarfield [] = return ()
drawStarfield : List (Int, Int) -> Eff () [SDL_ON]
drawStarfield [] = pure ()
drawStarfield ((x, y) :: xs) = do line white x y x y
drawStarfield xs

Expand All @@ -73,25 +73,25 @@ emain = do initialise 640 480
eventLoop
quit
where process : Maybe Event -> Running Bool
process (Just AppQuit) = return False
process (Just AppQuit) = pure False

process (Just (KeyDown KeyLeftArrow)) = do XMove :- put (-1)
return True
pure True
process (Just (KeyUp KeyLeftArrow)) = do XMove :- put 0
return True
pure True
process (Just (KeyDown KeyRightArrow)) = do XMove :- put 1
return True
pure True
process (Just (KeyUp KeyRightArrow)) = do XMove :- put 0
return True
pure True
process (Just (KeyDown KeyUpArrow)) = do YMove :- put (-1)
return True
pure True
process (Just (KeyUp KeyUpArrow)) = do YMove :- put 0
return True
pure True
process (Just (KeyDown KeyDownArrow)) = do YMove :- put 1
return True
pure True
process (Just (KeyUp KeyDownArrow)) = do YMove :- put 0
return True
process _ = return True
pure True
process _ = pure True

draw : Running ()
draw = do rectangle black 0 0 640 480
Expand Down Expand Up @@ -132,12 +132,10 @@ emain = do initialise 640 480
when continue eventLoop

main : IO ()
main = run [(), Position := (320,200),
main = runInit [(), Position := (320,200),
XMove := 0,
YMove := 0,
Frames := 0,
Starfield := List.Nil,
1234567890,
()] emain


8 changes: 5 additions & 3 deletions test/test.idr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,11 @@ import Graphics.SDL

main : IO ()
main = do surface <- startSDL 640 480
flipBuffers surface
case surface of
Nothing => putStrLn "startSDL failed"
Just surface => do flipBuffers surface
eventLoop surface 0 320 200 0 0

eventLoop surface 0 320 200 0 0
where eventLoop : SDLSurface -> Integer -> Int -> Int -> Int -> Int -> IO ()
processEvent : SDLSurface -> Integer -> Int -> Int -> Int -> Int -> Maybe Event -> IO ()

Expand Down Expand Up @@ -35,7 +37,7 @@ main = do surface <- startSDL 640 480
= eventLoop s f x y mx 1
processEvent s f x y mx my (Just (KeyUp KeyDownArrow))
= eventLoop s f x y mx 0
processEvent s f x y mx my (Just AppQuit) = return ()
processEvent s f x y mx my (Just AppQuit) = pure ()
processEvent s f x y mx my (Just (KeyDown (KeyAny k)))
= do print k
eventLoop s f x y mx my
Expand Down