From cd9608c7240fea208f0def3d6118c32b61b9901a Mon Sep 17 00:00:00 2001 From: Conor Newton Date: Wed, 25 Apr 2018 15:27:12 +0100 Subject: [PATCH] fixed test.idr and etest.idr by changing return to pure and using new effects syntax --- test/etest.idr | 38 ++++++++++++++++++-------------------- test/test.idr | 8 +++++--- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/test/etest.idr b/test/etest.idr index 07fa30e..5000d61 100644 --- a/test/etest.idr +++ b/test/etest.idr @@ -39,16 +39,16 @@ 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 @@ -56,8 +56,8 @@ updateStarfield xs = upd [] xs where 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 @@ -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 @@ -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 - - diff --git a/test/test.idr b/test/test.idr index d1332c0..90bc2d7 100644 --- a/test/test.idr +++ b/test/test.idr @@ -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 () @@ -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