Przedmowa
Po 3 miesiącach kopanie przez licznych stron internetowych i starając się kilka małych projektów, ale w końcu dostać się do wdrożenia minimalistyczny gry (lub nie?), W bardzo różny sposób. Ten przykład ma jedynie na celu wykazanie jednej możliwej struktury gry napisanej w języku Haskell i powinien być łatwo rozszerzony na bardziej złożoną logikę i rozgrywkę.
Pełny kod i samouczek dostępny na https://github.com/carldong/HMovePad-Tutorial
Streszczenie
Ta mini gra ma tylko jeden prostokąt, który gracz może przejść w lewo i prawo, naciskając Lewo i klucz w prawo, i to jest cała „gra ".
Gra jest realizowana za pomocą netwire-5.0.1, z obsługą grafiki SDL. Jeśli dobrze rozumiem, architektura jest w pełni funkcjonalna. Niemal wszystko zostało zaimplementowane za pomocą kompozycji Arrow, a tylko jedna funkcja jest wyświetlana w IO. Dlatego oczekuję od czytelnika podstawowej wiedzy na temat składni Arrow Haskella, ponieważ jest on szeroko stosowany.
Kolejność realizacji tej gry została wybrana w celu ułatwienia debugowania, a sama implementacja została wybrana tak, aby w jak największym stopniu demonstrować różne użycie numeru netwire.
Ciągły semantyczny czas jest używany do operacji we/wy, ale dyskretne zdarzenia są używane do obsługi zdarzeń w grze w logice gry.
Konfigurowanie SDL
Pierwszym krokiem jest upewnienie się prace SDL. Źródło jest proste:
module Main where
import qualified Graphics.UI.SDL as SDL
main :: IO()
main = do
SDL.init [SDL.InitEverything]
w <- SDL.setVideoMode 800 600 32 [SDL.SWSurface]
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
SDL.fillRect s (Just testRect) (SDL.Pixel 0xFFFFFFFF)
SDL.blitSurface s (Nothing) w (Nothing)
SDL.flip w
testLoop
SDL.quit
where
testLoop = testLoop
testRect = SDL.Rect 350 500 100 50
Jeśli wszystko działa, powinien pojawić się biały prostokąt pojawiający się na dole okna. Uwaga: kliknięcie przycisku x nie spowoduje zamknięcia okna. Musi zostać zamknięte przez Ctrl-C lub zabicie.
Konfiguracja przewodów wyjściowych
Ponieważ nie chcemy wdrożyć całą drogę do ostatniego etapu i okaże się, że nic nie można wyciągnąć na ekranie, robimy część wyjściową pierwszy.
Musimy składnię Arrows:
{-# LANGUAGE Arrows #-}
Również musimy importować kilka rzeczy:
import Prelude hiding ((.), id)
import Control.Wire
import Control.Arrow
import Control.Monad
import Data.Monoid
import qualified Graphics.UI.SDL as SDL
Musimy zrozumieć, w jaki sposób skonstruować Przewody Kleisli: Kleisli Arrow in Netwire 5?. Podstawowa struktura interaktywnego programu przy użyciu Kleisli Wires jest pokazana w tym przykładzie: Console interactivity in Netwire?. Aby skonstruować Kleisli przewód od wszystkiego z rodzaju a -> m b, musimy:
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
Następnie, ponieważ nie dostać trace do pracy w procesach strzałek, drut debug jest drukowanie obiektów pocieszyć:
wDebug :: (Show a, Monoid e) => Wire s e IO a()
wDebug = mkKleisli $ \a -> putStrLn $ show a
Teraz nadszedł czas, aby napisać niektóre funkcje, które należy podnieść na druty. Dla wyjścia, musimy funkcję zwracającą SDL.Surface z właściwego prostokąta opracowanego danej współrzędnej X klocka:
padSurf :: SDL.Surface
-> Int
-> IO SDL.Surface
padSurf surf x' = do
let rect' = SDL.Rect x' 500 100 50
clipRect <- SDL.getClipRect surf
SDL.fillRect surf (Just clipRect) (SDL.Pixel 0x00000000)
SDL.fillRect surf (Just rect') (SDL.Pixel 0xFFFFFFFF)
return surf
być ostrożnym, funkcja ta działa destrukcyjne aktualizacji. Przeniesiona powierzchnia zostanie później naświetlona na powierzchni okna.
Teraz mamy powierzchnię. Przewód wyjściowy jest następnie trivil:
wTestOutput :: SDL.Surface -> Wire s() IO() SDL.Surface
wTestOutput surf = mkKleisli $ \_ -> testPad
where
testPad = padSurf surf 350
Następnie kładziemy przewody razem i grać z nimi trochę:
gameWire :: SDL.Surface
-> Wire s() IO() SDL.Surface
gameWire w = proc _ -> do
finalSurf <- wTestOutput w -<()
wDebug -< "Try a debug message"
returnA -< finalSurf
Wreszcie możemy zmienić main i jechać przewody odpowiednio:
main :: IO()
main = do
SDL.init [SDL.InitEverything]
w <- SDL.setVideoMode 800 600 32 [SDL.SWSurface]
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
run w (countSession_ 1) $ gameWire w
SDL.quit
run ::SDL.Surface -> Session IO s -> Wire s() IO() SDL.Surface -> IO()
run mainSurf s w = do
(ds, s') <- stepSession s
(eSrcSurf, w') <- stepWire w ds (Right())
case eSrcSurf of
Right srcSurf -> do
SDL.blitSurface srcSurf (Nothing) mainSurf (Nothing)
SDL.flip mainSurf
SDL.delay 30
run mainSurf s' w'
_ -> return()
Zauważ, że jeśli chcesz, możesz również wykonać inny przewód do obsługi głównej powierzchni okna (i jest to łatwe i lepsze niż moja obecna implementacja), ale byłem już za późno i leniwy do dodaj to. Zapoznaj się z interaktywnym przykładem, o którym wspomniałem powyżej, aby zobaczyć, jak proste może być uzyskanie run (może być jeszcze prostsze, jeśli w tym przykładzie zastosowano zamiast niego quitWire).
Po uruchomieniu programu jego wygląd powinien być taki sam jak poprzednio.
Oto kompletny kod:
{-|
01-OutputWires.hs: This step, the output wires are constructed first for
easy debugging
-}
{-# LANGUAGE Arrows #-}
module Main where
import Prelude hiding ((.), id)
import Control.Wire
import Control.Arrow
import Control.Monad
import Data.Monoid
import qualified Graphics.UI.SDL as SDL
{- Wire Utilities -}
-- | Make a Kleisli wire
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
-- | The debug wire
wDebug :: (Show a, Monoid e) => Wire s e IO a()
wDebug = mkKleisli $ \a -> putStrLn $ show a
{- Functions to be lifted -}
padSurf :: SDL.Surface
--^Previous state of surface
-> Int
--^X'
-- | New state
-> IO SDL.Surface
padSurf surf x' = do
let rect' = SDL.Rect x' 500 100 50
clipRect <- SDL.getClipRect surf
SDL.fillRect surf (Just clipRect) (SDL.Pixel 0x00000000)
SDL.fillRect surf (Just rect') (SDL.Pixel 0xFFFFFFFF)
return surf
{- Wires -}
wTestOutput :: SDL.Surface -> Wire s() IO() SDL.Surface
wTestOutput surf = mkKleisli $ \_ -> testPad
where
testPad = padSurf surf 350
-- | This is the main game wire
gameWire :: SDL.Surface
--^The main surface (i.e. the window)
-> Wire s() IO() SDL.Surface
gameWire w = proc _ -> do
finalSurf <- wTestOutput w -<()
wDebug -< "Try a debug message"
returnA -< finalSurf
main :: IO()
main = do
SDL.init [SDL.InitEverything]
w <- SDL.setVideoMode 800 600 32 [SDL.SWSurface]
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
run w (countSession_ 1) $ gameWire w
SDL.quit
run ::SDL.Surface -> Session IO s -> Wire s() IO() SDL.Surface -> IO()
run mainSurf s w = do
(ds, s') <- stepSession s
(eSrcSurf, w') <- stepWire w ds (Right())
case eSrcSurf of
Right srcSurf -> do
SDL.blitSurface srcSurf (Nothing) mainSurf (Nothing)
SDL.flip mainSurf
SDL.delay 30
run mainSurf s' w'
_ -> return()
Przewody wejściowe
W tej części będziemy konstruować przewody, który pobiera dane wejściowe player do programu.
Ponieważ będziemy używać zdarzeń dyskretnych w części logiki musimy typ danych dla zdarzeń gra:
data GameEvent = MoveR
| MoveL
| NoEvent
deriving (Show, Eq)
-- | Make it Monoid so that game events can be combined
-- (Only applicable in this "game"!)
instance Monoid GameEvent where
mempty = NoEvent
-- | Simultaneously moving left and right is just nothing
MoveR `mappend` MoveL = NoEvent
MoveL `mappend` MoveR = NoEvent
-- | NoEvent is the identity
NoEvent `mappend` x = x
x `mappend` NoEvent = x
x `mappend` y
-- | Make sure identical events return same events
| x == y = x
-- | Otherwise, no event
| otherwise = NoEvent
Jako komentarz sugeruje, instancja Monoid stosuje się tylko do tej konkretnej gry, ponieważ ma tylko dwa odwrotnie operacje: w lewo i w prawo.
Po pierwsze, będziemy odpytywać wydarzenia z SDL:
pollEvents :: [SDL.Event] -> IO (Either() ([SDL.Event]))
pollEvents es = do
e <- SDL.pollEvent
case e of
SDL.NoEvent -> return $ Right es
SDL.Quit -> return $ Left()
_ -> pollEvents $ e:es
wystarczająco Oczywiście funkcja ta odpytuje zdarzenia z SDL jak listy, a hamuje po odebraniu zdarzenia Quit.
Następnie musimy sprawdzić, czy zdarzenie jest zdarzeniem klawiatura:
isKeyEvent :: SDL.Event -> Bool
isKeyEvent (SDL.KeyDown k) = True
isKeyEvent (SDL.KeyUp k) = True
isKeyEvent _ = False
Będziemy mieć listę kluczy, które są aktualnie wciśnięty, i powinien aktualizować, gdy wystąpi zdarzenie klawiatury. W skrócie, gdy klucz jest w dół, włóż klucz do listy, i odwrotnie:
keyStatus :: [SDL.Keysym] -> [SDL.Event] -> [SDL.Keysym]
keyStatus keysDown (e:es) =
case e of
-- | If a KeyDown is detected, add key to list
SDL.KeyDown k -> keyStatus (k:keysDown) es
-- | If a KeyUp is detected, remove key from list
SDL.KeyUp k -> keyStatus (filter (/= k) keysDown) es
_ -> keyStatus keysDown es
keyStatus keysDown [] = keysDown
Następnie piszemy funkcję konwertowania zdarzenie klawiatury na razie gra:
toGameEv :: SDL.Keysym -> GameEvent
toGameEv (SDL.Keysym SDL.SDLK_RIGHT _ _) = MoveR
toGameEv (SDL.Keysym SDL.SDLK_LEFT _ _) = MoveL
toGameEv _ = NoEvent
Składamy wydarzenia związane z grą i otrzymujemy jedno wydarzenie (naprawdę, naprawdę, specyficzne dla gry!):
fireGameEv :: [SDL.Keysym] -> GameEvent
fireGameEv ks = foldl mappend NoEvent $ fmap toGameEv ks
Teraz możemy rozpocząć wykonywanie przewodów.
Po pierwsze, musimy drutu, który sonduje zdarzenia:
wPollEvents :: Wire s() IO() [SDL.Event]
wPollEvents = mkGen_ $ \_ -> pollEvents []
Zauważ, że mkKleisli sprawia, że przewód nie hamuje, ale chcemy hamowanie w tym drutu, ponieważ program powinien zakończyć, kiedy to ma. Dlatego używamy tutaj mkGen_.
Następnie musimy filtrować zdarzenia. Po pierwsze, upewnij funkcję pomocnika, który sprawia, ciągły przewód filtra Czas:
mkFW_ :: (Monad m, Monoid e) => (a -> Bool) -> Wire s e m [a] [a]
mkFW_ f = mkSF_ $ filter f
Korzystając mkFW_ aby filtr:
wKeyEvents :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Event]
wKeyEvents = mkFW_ isKeyEvent
Następnie musimy inną dogodną funkcję, aby przewód stanowej z Stateful funkcja typu b -> a -> b:
mkSW_ :: (Monad m, Monoid e) => b -> (b->a->b) -> Wire s e m a b
mkSW_ b0 f = mkSFN $ g b0
where
g b0 a = let b1 = f b0 a in
(b1, mkSW_ b1 f)
Następnie skonstruować pełnostanowego drut który zapamiętuje wszystkie kluczową status:
wKeyStatus :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Keysym]
wKeyStatus = mkSW_ empty keyStatus
Ostatni kawałek odcinka drutu pożary zdarzenie gra:
wFireGameEv :: (Monad m, Monoid e) => Wire s e m [SDL.Keysym] (GameEvent)
wFireGameEv = arr fireGameEv
Aby aktywnie ogień zdarzeń dyskretnych (netwire zdarzenia), które zawierają wydarzenia gry, musimy siekać netwire trochę (chyba że jest nadal dość niekompletny), ponieważ nie zapewniają, że przewód zawsze odpala zdarzenia:
always :: (Monad m, Monoid e) => Wire s e m a (Event a)
always = mkSFN $ \x -> (WE.Event x, always)
porównaniu do realizacji now, jedyną różnicą jest never i always.
Wreszcie wielka przewód, który łączy wszystkie przewody wejściowe powyżej:
wGameInput :: Wire s() IO() (Event GameEvent)
wGameInput = proc _ -> do
ge <- wFireGameEv <<< wKeyStatus
<<< wKeyEvents <<< wPollEvents -<()
e <- always -< ge
-- Debug!
case e of
WE.NoEvent -> wDebug -< "No Event?!!"
WE.Event g -> wDebug -< "Game Event: " ++ show g
-- End Debug
returnA -< e
Przykładem debugowania jest również pokazany w tym przewodzie.
interfejs z programu głównego, modyfikować gameWire używać wejścia:
gameWire w = proc _ -> do
ev <- wGameInput -<()
finalSurf <- wTestOutput w -<()
returnA -< finalSurf
Nic innego nie musi być zmieniony. Cóż, interesujące, prawda?
Po uruchomieniu programu konsola podaje wiele wyników pokazujących bieżące zdarzenia w grze. Spróbuj nacisnąć lewy i prawy, i ich kombinacje i zobacz, czy zachowanie jest oczekiwane. Oczywiście prostokąt się nie poruszy.
Oto ogromny blok kodu:
{-|
02-InputWires.hs: This step, input wires are constructed and
debugged by using wDebug
-}
{-# LANGUAGE Arrows #-}
module Main where
import Prelude hiding ((.), id)
import Control.Wire
import Control.Arrow
import Control.Monad
import Data.Monoid
import qualified Graphics.UI.SDL as SDL
import qualified Control.Wire.Unsafe.Event as WE
{- Data types -}
-- | The unified datatype of game events
data GameEvent = MoveR
| MoveL
| NoEvent
deriving (Show, Eq)
-- | Make it Monoid so that game events can be combined
-- (Only applicable in this "game"!)
instance Monoid GameEvent where
mempty = NoEvent
-- | Simultaneously moving left and right is just nothing
MoveR `mappend` MoveL = NoEvent
MoveL `mappend` MoveR = NoEvent
-- | NoEvent is the identity
NoEvent `mappend` x = x
x `mappend` NoEvent = x
x `mappend` y
-- | Make sure identical events return same events
| x == y = x
-- | Otherwise, no event
| otherwise = NoEvent
{- Wire Utilities -}
-- | Make a stateless filter wire
mkFW_ :: (Monad m, Monoid e) => (a -> Bool) -> Wire s e m [a] [a]
mkFW_ f = mkSF_ $ filter f
-- -- | Make a stateful wire from a chained stateful function and initial value
-- -- The function (a -> b -> a) takes in an old state /a/, and returns state
-- -- transition function (b -> a).
mkSW_ :: (Monad m, Monoid e) => b -> (b->a->b) -> Wire s e m a b
mkSW_ b0 f = mkSFN $ g b0
where
g b0 a = let b1 = f b0 a in
(b1, mkSW_ b1 f)
-- | Make a Kleisli wire
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
-- | The debug wire
wDebug :: (Show a, Monoid e) => Wire s e IO a()
wDebug = mkKleisli $ \a -> putStrLn $ show a
-- | The "always" wire
always :: (Monad m, Monoid e) => Wire s e m a (Event a)
always = mkSFN $ \x -> (WE.Event x, always)
{- Functions to be lifted -}
-- | This is the pad surface whose X coordinate can be updated
padSurf :: SDL.Surface
--^Previous state of surface
-> Int
--^X'
-- | New state
-> IO SDL.Surface
padSurf surf x' = do
let rect' = SDL.Rect x' 500 100 50
clipRect <- SDL.getClipRect surf
SDL.fillRect surf (Just clipRect) (SDL.Pixel 0x00000000)
SDL.fillRect surf (Just rect') (SDL.Pixel 0xFFFFFFFF)
return surf
-- | The function to poll events and add to a list of events
pollEvents :: [SDL.Event] -> IO (Either() ([SDL.Event]))
pollEvents es = do
e <- SDL.pollEvent
case e of
SDL.NoEvent -> return $ Right es
SDL.Quit -> return $ Left()
_ -> pollEvents $ e:es
-- | Checks whether one SDL.Event is a keyboard event
isKeyEvent :: SDL.Event -> Bool
isKeyEvent (SDL.KeyDown k) = True
isKeyEvent (SDL.KeyUp k) = True
isKeyEvent _ = False
-- | The raw function to process key status from events
keyStatus :: [SDL.Keysym] -> [SDL.Event] -> [SDL.Keysym]
keyStatus keysDown (e:es) =
case e of
-- | If a KeyDown is detected, add key to list
SDL.KeyDown k -> keyStatus (k:keysDown) es
-- | If a KeyUp is detected, remove key from list
SDL.KeyUp k -> keyStatus (filter (/= k) keysDown) es
_ -> keyStatus keysDown es
-- | If all events are processed, return
keyStatus keysDown [] = keysDown
-- | Convert a SDL Keysym into "standard" game events
toGameEv :: SDL.Keysym -> GameEvent
toGameEv (SDL.Keysym SDL.SDLK_RIGHT _ _) = MoveR
toGameEv (SDL.Keysym SDL.SDLK_LEFT _ _) = MoveL
toGameEv _ = NoEvent
-- | Combine all game events to get one single firing
fireGameEv :: [SDL.Keysym] -> GameEvent
fireGameEv ks = foldl mappend NoEvent $ fmap toGameEv ks
{- Wires -}
-- | The Kleisli wire to poll events
wPollEvents :: Wire s() IO() [SDL.Event]
wPollEvents = mkGen_ $ \_ -> pollEvents []
-- | A stateless wire that filters out keyboard events
wKeyEvents :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Event]
wKeyEvents = mkFW_ isKeyEvent
-- | A stateful wire to keep track of key status
wKeyStatus :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Keysym]
wKeyStatus = mkSW_ empty keyStatus
-- | A wire to fire game events from SDL events
wFireGameEv :: (Monad m, Monoid e) => Wire s e m [SDL.Keysym] (GameEvent)
wFireGameEv = arr fireGameEv
-- | This is the connected wire for the entire game input
wGameInput :: Wire s() IO() (Event GameEvent)
wGameInput = proc _ -> do
ge <- wFireGameEv <<< wKeyStatus
<<< wKeyEvents <<< wPollEvents -<()
e <- always -< ge
-- Debug!
case e of
WE.NoEvent -> wDebug -< "No Event?!!"
WE.Event g -> wDebug -< "Game Event: " ++ show g
-- End Debug
returnA -< e
-- | The wire to test output
wTestOutput :: SDL.Surface -> Wire s() IO() SDL.Surface
wTestOutput surf = mkKleisli $ \_ -> testPad
where
testPad = padSurf surf 350
-- | This is the main game wire
gameWire :: SDL.Surface
--^The main surface (i.e. the window)
-> Wire s() IO() SDL.Surface
gameWire w = proc _ -> do
ev <- wGameInput -<()
finalSurf <- wTestOutput w -<()
returnA -< finalSurf
main :: IO()
main = do
SDL.init [SDL.InitEverything]
w <- SDL.setVideoMode 800 600 32 [SDL.SWSurface]
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
run w (countSession_ 1) $ gameWire w
SDL.quit
run ::SDL.Surface -> Session IO s -> Wire s() IO() SDL.Surface -> IO()
run mainSurf s w = do
(ds, s') <- stepSession s
(eSrcSurf, w') <- stepWire w ds (Right())
case eSrcSurf of
Right srcSurf -> do
SDL.blitSurface srcSurf (Nothing) mainSurf (Nothing)
SDL.flip mainSurf
SDL.delay 30
run mainSurf s' w'
_ -> return()
"Gra" Logic --- Wreszcie wprowadzenie wszystko razem!
Najpierw piszemy integrującą funkcję położenia X klocka:
padDX :: Int -> GameEvent -> Int
padDX x0 e
| x > 700 = 700
| x < 0 = 0
| otherwise = x
where
x = x0 + go e
go MoveR = dx
go MoveL = -dx
go _ = 0
dx = 15
I zakodowanego wszystko, ale te, które nie są istotne dla tej minimalistycznej przykład. Powinno być proste.
Następnie tworzymy przewód, który reprezentuje aktualną pozycję podkładki:
wPadX :: (Monad m, Monoid e) => Wire s e m (Event GameEvent) Int
wPadX = accumE padDX 400 >>> hold
hold trzyma najpóźniej wartości strumienia dyskretne zdarzenia.
Następnie kładziemy wszystko logicznych w wielkim drutu logicznych:
wGameLogic :: Wire s() IO (Event GameEvent) Int
wGameLogic = proc ev -> do
x' <- wPadX -< ev
returnA -< x'
Ponieważ mamy jedno państwo o współrzędna X, musimy zmodyfikować przewód wyjściowy:
wGameOutput :: SDL.Surface -> Wire s() IO Int SDL.Surface
wGameOutput surf = mkKleisli $ testPad
where
testPad = padSurf surf
Wreszcie , łańcuchujemy wszystko, co trzeba, aby nic się nie zmieniło: gameWire: w main i run. Łał!
I to jest to! Uruchom, a będziesz w stanie przesunąć prostokąt w lewo iw prawo!
gigantyczny blok kodu (jestem ciekawy jak długo program C++, który robi to samo będzie):
{-|
03-GameLogic.hs: The final product!
-}
{-# LANGUAGE Arrows #-}
module Main where
import Prelude hiding ((.), id)
import Control.Wire
import Control.Arrow
import Control.Monad
import Data.Monoid
import qualified Graphics.UI.SDL as SDL
import qualified Control.Wire.Unsafe.Event as WE
{- Data types -}
-- | The unified datatype of game events
data GameEvent = MoveR
| MoveL
| NoEvent
deriving (Show, Eq)
-- | Make it Monoid so that game events can be combined
-- (Only applicable in this "game"!)
instance Monoid GameEvent where
mempty = NoEvent
-- | Simultaneously moving left and right is just nothing
MoveR `mappend` MoveL = NoEvent
MoveL `mappend` MoveR = NoEvent
-- | NoEvent is the identity
NoEvent `mappend` x = x
x `mappend` NoEvent = x
x `mappend` y
-- | Make sure identical events return same events
| x == y = x
-- | Otherwise, no event
| otherwise = NoEvent
{- Wire Utilities -}
-- | Make a stateless filter wire
mkFW_ :: (Monad m, Monoid e) => (a -> Bool) -> Wire s e m [a] [a]
mkFW_ f = mkSF_ $ filter f
-- -- | Make a stateful wire from a chained stateful function and initial value
-- -- The function (a -> b -> a) takes in an old state /a/, and returns state
-- -- transition function (b -> a).
mkSW_ :: (Monad m, Monoid e) => b -> (b->a->b) -> Wire s e m a b
mkSW_ b0 f = mkSFN $ g b0
where
g b0 a = let b1 = f b0 a in
(b1, mkSW_ b1 f)
-- | Make a Kleisli wire
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
-- | The debug wire
wDebug :: (Show a, Monoid e) => Wire s e IO a()
wDebug = mkKleisli $ \a -> putStrLn $ show a
-- | The "always" wire
always :: (Monad m, Monoid e) => Wire s e m a (Event a)
always = mkSFN $ \x -> (WE.Event x, always)
{- Functions to be lifted -}
-- | This is the pad surface whose X coordinate can be updated
padSurf :: SDL.Surface
--^Previous state of surface
-> Int
--^X'
-- | New state
-> IO SDL.Surface
padSurf surf x' = do
let rect' = SDL.Rect x' 500 100 50
clipRect <- SDL.getClipRect surf
SDL.fillRect surf (Just clipRect) (SDL.Pixel 0x00000000)
SDL.fillRect surf (Just rect') (SDL.Pixel 0xFFFFFFFF)
return surf
-- | The function to poll events and add to a list of events
pollEvents :: [SDL.Event] -> IO (Either() ([SDL.Event]))
pollEvents es = do
e <- SDL.pollEvent
case e of
SDL.NoEvent -> return $ Right es
SDL.Quit -> return $ Left()
_ -> pollEvents $ e:es
-- | Checks whether one SDL.Event is a keyboard event
isKeyEvent :: SDL.Event -> Bool
isKeyEvent (SDL.KeyDown k) = True
isKeyEvent (SDL.KeyUp k) = True
isKeyEvent _ = False
-- | The raw function to process key status from events
keyStatus :: [SDL.Keysym] -> [SDL.Event] -> [SDL.Keysym]
keyStatus keysDown (e:es) =
case e of
-- | If a KeyDown is detected, add key to list
SDL.KeyDown k -> keyStatus (k:keysDown) es
-- | If a KeyUp is detected, remove key from list
SDL.KeyUp k -> keyStatus (filter (/= k) keysDown) es
_ -> keyStatus keysDown es
-- | If all events are processed, return
keyStatus keysDown [] = keysDown
-- | Convert a SDL Keysym into "standard" game events
toGameEv :: SDL.Keysym -> GameEvent
toGameEv (SDL.Keysym SDL.SDLK_RIGHT _ _) = MoveR
toGameEv (SDL.Keysym SDL.SDLK_LEFT _ _) = MoveL
toGameEv _ = NoEvent
-- | Combine all game events to get one single firing
fireGameEv :: [SDL.Keysym] -> GameEvent
fireGameEv ks = foldl mappend NoEvent $ fmap toGameEv ks
-- | The integrator of X position of pad
padDX :: Int -> GameEvent -> Int
padDX x0 e
| x > 700 = 700
| x < 0 = 0
| otherwise = x
where
x = x0 + go e
go MoveR = dx
go MoveL = -dx
go _ = 0
dx = 15
{- Wires -}
-- | The Kleisli wire to poll events
wPollEvents :: Wire s() IO() [SDL.Event]
wPollEvents = mkGen_ $ \_ -> pollEvents []
-- | A stateless wire that filters out keyboard events
wKeyEvents :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Event]
wKeyEvents = mkFW_ isKeyEvent
-- | A stateful wire to keep track of key status
wKeyStatus :: (Monad m, Monoid e) => Wire s e m [SDL.Event] [SDL.Keysym]
wKeyStatus = mkSW_ empty keyStatus
-- | A wire to fire game events from SDL events
wFireGameEv :: (Monad m, Monoid e) => Wire s e m [SDL.Keysym] (GameEvent)
wFireGameEv = arr fireGameEv
-- | This is the connected wire for the entire game input
wGameInput :: Wire s() IO() (Event GameEvent)
wGameInput = proc _ -> do
ge <- wFireGameEv <<< wKeyStatus
<<< wKeyEvents <<< wPollEvents -<()
e <- always -< ge
returnA -< e
-- | The stateful wire of X position of pad
wPadX :: (Monad m, Monoid e) => Wire s e m (Event GameEvent) Int
wPadX = accumE padDX 400 >>> hold
-- | This is the connected wire for the entire game logic
wGameLogic :: Wire s() IO (Event GameEvent) Int
wGameLogic = proc ev -> do
x' <- wPadX -< ev
returnA -< x'
-- | The wire of output
wGameOutput :: SDL.Surface -> Wire s() IO Int SDL.Surface
wGameOutput surf = mkKleisli $ testPad
where
testPad = padSurf surf
-- | This is the main game wire
gameWire :: SDL.Surface
--^The main surface (i.e. the window)
-> Wire s() IO() SDL.Surface
gameWire w = proc _ -> do
ev <- wGameInput -<()
x <- wGameLogic -< ev
finalSurf <- wGameOutput w -< x
returnA -< finalSurf
main :: IO()
main = do
SDL.init [SDL.InitEverything]
w <- SDL.setVideoMode 800 600 32 [SDL.SWSurface]
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
run w (countSession_ 1) $ gameWire w
SDL.quit
run ::SDL.Surface -> Session IO s -> Wire s() IO() SDL.Surface -> IO()
run mainSurf s w = do
(ds, s') <- stepSession s
(eSrcSurf, w') <- stepWire w ds (Right())
case eSrcSurf of
Right srcSurf -> do
SDL.blitSurface srcSurf (Nothing) mainSurf (Nothing)
SDL.flip mainSurf
SDL.delay 30
run mainSurf s' w'
_ -> return()
Haskell nie ma żadnego innego języka, który został użyty. Wywołania funkcji nie używają stosu. A 'IO' nie jest funkcją. Potrzebujesz nowych modeli mentalnych - te, które masz, prowadzą cię na manowce. – Carl
Nie sugerowałbym tej gry przygodowej jako modelu. Kod wydaje się być niewystarczająco uporządkowany i prawie nieczytelny. – dfeuer
Rekurencja ogona nie ma tak centralnego znaczenia dla zachowania pamięci w Haskell, jak to zwykle bywa w językach wywołania po wartości.Bliższym mentalnym modelem tego, o co się nam chodzi, są rekurencyjne modulo cons, mniej powszechny schemat, ale faktyczna operacyjna semantyka Haskella opiera się na "redukcji grafów". Najlepszym sposobem, aby o tym pomyśleć, jest prawdopodobnie zredukowanie ekspresji ręcznie, praca zawsze z zewnątrz. – dfeuer