├── Aufgabe.pdf ├── Aufgabe.tex ├── GifStream.hs ├── LICENSE ├── README.md ├── Snake.hs ├── SnakeFinished.hs ├── listmonster.png ├── snake.cabal ├── snake.gif └── snake.png /Aufgabe.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/def-/gifstream/1caaee3d060e9e38c1c3816afc0fd9ce94f651c7/Aufgabe.pdf -------------------------------------------------------------------------------- /Aufgabe.tex: -------------------------------------------------------------------------------- 1 | \documentclass{scrartcl} 2 | \usepackage{parskip} 3 | \usepackage[utf8]{inputenc} 4 | \usepackage[T1]{fontenc} 5 | \usepackage[ngerman]{babel} 6 | \usepackage{amsmath} 7 | \usepackage{listings} 8 | \usepackage{graphicx} 9 | 10 | \lstset{basicstyle=\ttfamily,columns=fixed} 11 | 12 | \begin{document} 13 | 14 | \section{Haskell: Spieleprogrammierung mit GIF-Streams} 15 | 16 | Snake ist ein Computerspiel, bei dem man eine Schlange duch ein Spielfeld steuert. 17 | Futter zu essen verlängert die Schlange. 18 | Kollidiert die Schlange mit einer Wand oder sich selbst, so endet das Spiel. 19 | 20 | \begin{center} 21 | \includegraphics{snake} 22 | \end{center} 23 | 24 | In dieser Aufgabe implementieren Sie Snake in Haskell. 25 | Das dazu benötigte Rahmenwerk finden Sie auf der Übungshomepage. 26 | 27 | Die Ausgabe des Spiels erfolgt über einen animierten GIF-Stream, den man im Browser anschauen kann. 28 | Es werden 64 Farben unterstützt, die als Int-Tupel von (0,0,0) bis (3,3,3) angesprochen werden. 29 | 30 | \begin{lstlisting} 31 | type RGB = (Int,Int,Int) 32 | \end{lstlisting} 33 | 34 | Ein einzelner Frame einer GIF ist definiert als Liste von Zeilen, wobei jede Zeile eine Liste von RGB-Werten ist. 35 | 36 | \begin{lstlisting} 37 | type Frame = [[RGB]] 38 | \end{lstlisting} 39 | 40 | Das Rahmenwerk stellt eine Funktion \texttt{server} zur Verfügung, die einen HTTP-Server unter dem angegebenen Port startet. 41 | Der Server schickt jedem Client in einem festgelegten Intervall einen neuen Frame der GIF-Animation. 42 | In der übergebenen Logic-Funktion werden dynamisch neue Frames generiert. 43 | 44 | \begin{lstlisting} 45 | server :: PortNumber -> Int -> Logic -> IO () 46 | \end{lstlisting} 47 | 48 | Die Datei \texttt{Snake.hs} enthält das Grundgerüst für das zu schreibende Snake-Spiel. 49 | Kompilieren Sie das Spiel und führen Sie es aus: 50 | 51 | \begin{lstlisting} 52 | $ ghc -O3 -threaded Snake.hs 53 | [1 of 2] Compiling GifStream ( GifStream.hs, GifStream.o ) 54 | [2 of 2] Compiling Main ( Snake.hs, Snake.o ) 55 | Linking Snake ... 56 | $ ./Snake 57 | Listening on http://127.0.0.1:5002/ 58 | \end{lstlisting} 59 | 60 | Öffnen Sie die angegebene Adresse in einem Browser. 61 | Durch Drücken der Tasten WASD im Terminal lässt sich die GIF im Browser beeinflussen. 62 | 63 | Anderen Teilnehmern Ihres Netzwerks ist es ebenfalls möglich den GIF-Stream zu betrachten, indem Sie statt \texttt{127.0.0.1} Ihre Netzwerk-IP-Adresse eintragen. 64 | 65 | Desweiteren ist es möglich den GIF-Stream aufzunehmen um ihn später anzuschauen: 66 | 67 | \begin{lstlisting} 68 | wget -O game.gif http://127.0.0.1:5002/ 69 | \end{lstlisting} 70 | 71 | Die wichtigste Funktion in \texttt{Snake.hs} ist \texttt{logic}: 72 | 73 | \begin{lstlisting} 74 | logic wait getInput sendFrame = initialState >>= go 75 | where 76 | go (State oldAction snake food) = do 77 | input <- getInput 78 | 79 | -- Generate new state 80 | let action = charToAction input oldAction 81 | let newSnake = snake 82 | let newFood = food 83 | 84 | let frame = case action of 85 | MoveUp -> replicate height (replicate width (3,0,0)) 86 | MoveDown -> replicate height (replicate width (0,3,0)) 87 | MoveLeft -> replicate height (replicate width (0,0,3)) 88 | MoveRight -> replicate height (replicate width (3,3,3)) 89 | 90 | sendFrame (scale zoom frame) 91 | 92 | wait 93 | go (State action newSnake newFood) 94 | \end{lstlisting} 95 | 96 | Die Funktion \texttt{logic} erzeugt einen initialen Zustand für das Snake-Spiel und übergibt diesen an die \texttt{go}-Funktion. 97 | Diese liest mit \texttt{getInput} die zuletzt gedrückte Taste. 98 | Anschließend wird ein neuer Spielzustand generiert. 99 | Der anzuzeigende Frame wird dabei abhängig von der gedrückten Taste gewählt. 100 | Schließlich wird mit \texttt{sendFrame} ein neuer Frame an alle verbundenen Clients geschickt. 101 | Dabei wird jeder Frame durch \texttt{scale} vergrößert. 102 | Der Aufruf von \texttt{wait} bewirkt ein Warten für die vereinbarte Zeit \texttt{delay}, die standardmäßig auf $100 ms$ gesetzt ist. 103 | Am Ende der Funktion ruft diese sich selbst endrekursiv mit dem neu generierten Zustand auf. 104 | 105 | Ziel dieser Aufgabe ist es die Spiellogik in der Funktion \texttt{logic} schrittweise zu erweitern, so dass man am Ende Snake spielen kann. 106 | 107 | \subsection{Spielfeld ausgeben} 108 | Erzeugen Sie aus dem aktuellen Zustand ein Bild und geben Sie dieses statt der einfachen farbigen Bilder aus. 109 | 110 | Schreiben Sie dazu eine Liste \texttt{fieldPositions}, die die Koordinaten des Spielfelds an ihrer jeweiligen Position speichert. 111 | 112 | \begin{lstlisting} 113 | fieldPositions :: [[Position]] 114 | \end{lstlisting} 115 | 116 | Die Größe des Feldes ist dabei in \texttt{width} und \texttt{height} gespeichert. 117 | Für ein Feld der Größe 3x4 würde fieldPositions wie folgt aussehen: 118 | 119 | \begin{lstlisting} 120 | fieldPositions = [[(0,0),(1,0),(2,0)] 121 | ,[(0,1),(1,1),(2,1)] 122 | ,[(0,2),(1,2),(2,2)] 123 | ,[(0,3),(1,3),(2,3)]] 124 | \end{lstlisting} 125 | 126 | Implementieren Sie eine Funktion \texttt{colorize}, die eine einzelne Bildposition auf eine Farbe abbildet, so dass sich der neue Frame durch \texttt{let frame = map (map (colorize newSnake newFood)) fieldPositions} erzeugen lässt. 127 | Ein Feld soll verschieden eingefärbt werden, je nachdem ob diese Position Teil der Schlange, Futterstück oder Hintergrund ist. 128 | 129 | \begin{lstlisting} 130 | colorize :: [Position] -> Position -> Position -> RGB 131 | \end{lstlisting} 132 | 133 | \subsection{Verhalten Schlange} 134 | Implementieren Sie nun die Zustandsänderung der Schlange, so dass Sie in der Spiellogik \texttt{let newSnake = moveSnake snake food action} schreiben können. 135 | 136 | \begin{lstlisting} 137 | moveSnake :: [Position] -> Position -> Action -> Position 138 | \end{lstlisting} 139 | 140 | Eine Schlange ist als Liste von Positionen definiert. 141 | Die neue Schlange erhält abhängig von der übergebenen Aktion einen neuen Kopf. 142 | \texttt{Action} ist wie folgt definiert: 143 | 144 | \begin{lstlisting} 145 | data Action = MoveLeft | MoveRight | MoveUp | MoveDown deriving Eq 146 | \end{lstlisting} 147 | 148 | Beim Schwanz wird das letzte Element abgeschnitten, außer wenn die Schlange gerade auf Futter gestoßen ist. 149 | 150 | Es muss sichergestellt werden, dass die vom Benutzer gewählte Aktion überhaupt möglich ist. 151 | Schreiben Sie dazu eine Funktion \texttt{validateAction}, so dass Sie in der Spiellogik \texttt{let action = validateAction oldAction (charToAction input oldAction)} schreiben können. 152 | Dazu soll \texttt{validateAction} nur dann eine neue Aktion zurückgeben, wenn diese möglich ist. 153 | Ansonsten soll die alte Aktion zurückgegeben werden. 154 | 155 | %\includegraphics[width=\textwidth]{listmonster} 156 | 157 | \subsection{Verhalten Futter} 158 | Implementieren Sie nun die Zustandsänderung des Futters, so dass Sie in der Spiellogik \texttt{newFood <- moveFood newSnake food} schreiben können. 159 | 160 | \begin{lstlisting} 161 | moveFood :: [Position] -> Position -> IO Position 162 | \end{lstlisting} 163 | 164 | Wenn die Schlange gerade das Futter nicht isst, kann direkt die alte Position des Futters zurückgegeben werden. 165 | Ansonsten soll die neue Position des Futters zufällig gewählt werden. 166 | Vermeiden Sie dass das Futter im Körper der Schlange erscheint. 167 | 168 | Zufallszahlen zwischen $x$ und $y$ (einschließlich) lassen sich bei Verwendung der do-Syntax mit \texttt{r <- randomRIO (x,y)} generieren. 169 | Importieren Sie dazu \texttt{System.Random}. 170 | 171 | \subsection{Spielende} 172 | Passen Sie das Ende von \texttt{logic} so an, dass mit \texttt{checkGameOver newSnake} die Gültigkeit des neuen Zustands überprüft wird. 173 | Bei einem ungültigen Zustand soll das Spiel durch Aufruf von \texttt{initialState >{}>= go} neugestartet werden. 174 | 175 | \begin{lstlisting} 176 | checkGameOver :: [Position] -> Bool 177 | \end{lstlisting} 178 | 179 | \subsection{Kür} 180 | Programmieren Sie ein weiteres Spiel mit GIF-Stream-Ausgabe, zum Beispiel Pong, Tetris oder Conway's Game of Life. 181 | \end{document} 182 | -------------------------------------------------------------------------------- /GifStream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | Generate dynamic GIF streams and provide them on an HTTP server. 4 | module GifStream ( 5 | -- Functions 6 | server, 7 | -- Types 8 | RGB, 9 | Frame, 10 | FrameSignal, 11 | Logic 12 | ) 13 | where 14 | 15 | import System.IO 16 | 17 | import Network.Socket 18 | import Network.Socket.ByteString (sendAll) 19 | 20 | import Control.Monad 21 | import Control.Concurrent 22 | 23 | import Data.IORef 24 | 25 | import qualified Data.ByteString as B 26 | import qualified Data.ByteString.Char8() -- for OverloadedStrings 27 | 28 | type RGB = (Int,Int,Int) -- ^ Values in [0..3] 29 | type Frame = [[RGB]] 30 | type FrameSignal = MSignal Frame 31 | type Logic = IO () -> IO Char -> (Frame -> IO ()) -> IO () 32 | 33 | -- | Run an HTTP server that delivers a continuing stream of a GIF to every 34 | -- incoming connections. A logic function is called to generate the GIF 35 | -- frames. 36 | server :: PortNumber -> Int -> Logic -> IO () 37 | server port delay logic = withSocketsDo $ do 38 | hSetBuffering stdin NoBuffering 39 | sock <- socket AF_INET Stream 0 40 | setSocketOption sock ReuseAddr 1 41 | bind sock (SockAddrInet port 0) 42 | listen sock 10 -- Allow 10 concurrent users 43 | 44 | putStrLn $ "Listening on http://127.0.0.1:" ++ show port ++ "/" 45 | 46 | wait <- getMetronome delay 47 | getAction <- inputGetter 48 | frameSignal <- newMSignal 49 | 50 | forkIO $ loop delay frameSignal sock 51 | 52 | logic wait getAction $ sendMSignal frameSignal 53 | 54 | -- | Wait for incoming connections and start delivering a GIF to them 55 | loop :: Int -> FrameSignal -> Socket -> IO () 56 | loop delay frameSignal sock = do 57 | (conn, _) <- accept sock 58 | 59 | forkIO $ body conn 60 | loop delay frameSignal sock 61 | 62 | where -- lower delay in GIF to force browser to actually show the gif we send 63 | body c = do 64 | f <- receiveMSignal frameSignal 65 | sendAll c $ msg $ initialFrame (delay `div` 20000) f 66 | nextFrame c 67 | 68 | nextFrame c = do 69 | f <- receiveMSignal frameSignal 70 | sendAll c $ frame (delay `div` 20000) f 71 | nextFrame c 72 | 73 | msg content = B.intercalate "\r\n" 74 | [ "HTTP/1.0 200 OK" 75 | , "Server: gifstream/0.1" 76 | , "Content-Type: image/gif" 77 | , "Content-Transfer-Encoding: binary" 78 | , "" 79 | , content 80 | ] 81 | 82 | -- | Get a function that waits for the specified time whenever it's called 83 | getMetronome :: Int -> IO (IO ()) 84 | getMetronome delay = do 85 | var <- newMVar () 86 | forkIO $ forever $ do 87 | threadDelay delay 88 | putMVar var () 89 | return $ takeMVar var 90 | 91 | -- | Get a function that returns the last key pressed whenever it's called 92 | inputGetter :: IO (IO Char) 93 | inputGetter = do 94 | inputRef <- newIORef 'd' -- Default input 95 | forkIO $ forever $ do 96 | c <- getChar 97 | writeIORef inputRef c 98 | return $ readIORef inputRef 99 | 100 | -- | Create the initial frame of a GIF. Note that this frame determines the size of the GIF. 101 | initialFrame :: Int -> Frame -> B.ByteString 102 | initialFrame delay img = B.concat 103 | [ "GIF89a" 104 | , number w, number h, gctInfo, bgColor, aspect -- logical screen descriptor 105 | , realCT, dummyCT -- color table 106 | , "!\255\vNETSCAPE2.0\ETX\SOH\NUL\NUL\NUL" -- application extension 107 | , frame delay img 108 | ] 109 | where 110 | w = length $ head img 111 | h = length img 112 | gctInfo = B.singleton 0xf6 113 | bgColor = smallNumber 127 114 | aspect = "\NUL" 115 | 116 | realCT = B.concat $ map B.pack [[r,g,b] | r <- colors, g <- colors, b <- colors] 117 | colors = [0,64,128,255] 118 | dummyCT = B.concat $ replicate 64 $ B.pack [255,255,255] 119 | 120 | -- | Create the next frame in a GIF 121 | frame :: Int -> Frame -> B.ByteString 122 | frame delay img = B.concat 123 | [ "!\249\EOT\b", number delay, "\255", "\NUL" -- graphic control extension 124 | , ",", yPos, xPos, number w, number h, localCT -- image descriptor 125 | , lzwMinSize, imageData, "\NUL" -- image 126 | ] 127 | where 128 | w = length $ head img 129 | h = length img 130 | yPos = number 0 131 | xPos = number 0 132 | localCT = "\NUL" 133 | 134 | lzwMinSize = B.singleton 0x07 135 | imageData = B.concat $ map (B.concat . mapLine) img 136 | 137 | mapLine x 138 | | null ys = z 139 | | otherwise = z ++ mapLine ys 140 | where (y,ys) = splitAt 126 x 141 | z = [ bytesToFollow, clear 142 | , B.pack $ map (\(r,g,b) -> fromIntegral $ 16*r+4*g+b) y 143 | ] 144 | bytesToFollow = smallNumber $ length y + 1 145 | clear = B.singleton 0x80 146 | 147 | -- | Close the GIF file 148 | finalize :: B.ByteString 149 | finalize = B.concat [bytesToFollow, stop, "\NUL", ";"] 150 | where 151 | bytesToFollow = smallNumber 1 152 | stop = B.singleton 0x81 153 | 154 | -- | Convert a number to one Byte 155 | smallNumber :: Int -> B.ByteString 156 | smallNumber x = B.singleton $ fromIntegral $ x `mod` 256 157 | 158 | -- | Convert a number to two Bytes 159 | number :: Int -> B.ByteString 160 | number x = B.pack $ map fromIntegral [x `mod` 256, x `div` 256] 161 | 162 | -- | A Module for broadcast signalling between threads. 163 | -- By Joachim Breitner 164 | 165 | -- | MSignal is an opaque data type 166 | newtype MSignal a = MS (MVar a) 167 | 168 | -- | Creates a new MSignal object. This can be used to send and receive signals, possibly containing some data. If you do not want to transmit data, use @'MSignal' ()@ 169 | newMSignal :: IO (MSignal a) 170 | newMSignal = MS `liftM` newEmptyMVar 171 | 172 | -- | Sends new data to all threads currently running 'receiveMSignal' 173 | sendMSignal :: MSignal a -> a -> IO () 174 | sendMSignal (MS mv) v = do 175 | forkIO $ takeMVar mv >> return () -- Cleanup afterwards 176 | putMVar mv v 177 | 178 | -- | Blocks until another threads sends data using 'sendMSignal'. It then returns the sent data. 179 | receiveMSignal :: MSignal a -> IO a 180 | receiveMSignal (MS mv) = readMVar mv 181 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012 Dennis Felsing 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright 13 | notice, this list of conditions and the following disclaimer in the 14 | documentation and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the author nor the names of his contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR 21 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 28 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 | POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # gifstream 2 | Make interactive games in Haskell using GIF streams that can be shown in the webbrowser 3 | 4 | An example of snake is included. Compile and run: 5 | 6 | $ ghc -O3 -threaded SnakeFinished.hs 7 | $ ./SnakeFinished 8 | Listening on http://127.0.0.1:5002/ 9 | 10 | Control using wasd in the terminal, output in the browser looks like this: 11 | 12 | ![Snake GIF](https://raw.githubusercontent.com/def-/gifstream/master/snake.gif) 13 | -------------------------------------------------------------------------------- /Snake.hs: -------------------------------------------------------------------------------- 1 | import GifStream 2 | 3 | -- Stopping focus of the browser tab stops the animation. Reload the page to fix it. 4 | 5 | type Position = (Int,Int) 6 | 7 | data Action = MoveLeft | MoveRight | MoveUp | MoveDown deriving Eq 8 | 9 | data State = State 10 | { oldAction :: Action 11 | , snake :: [Position] 12 | , food :: Position 13 | } 14 | 15 | -- 30000 seems to be the lowest value that works in Firefox 16 | -- 30 ms => 33 fps 17 | delay = 100000 -- in µs 18 | port = 5002 19 | 20 | width = 32 21 | height = 32 22 | zoom = 4 23 | 24 | main :: IO () 25 | main = server port delay logic 26 | 27 | logic :: IO () -> IO Char -> (Frame -> IO ()) -> IO () 28 | logic wait getInput sendFrame = initialState >>= go 29 | where 30 | go (State oldAction snake food) = do 31 | input <- getInput 32 | 33 | -- Generate new state 34 | let action = charToAction input oldAction 35 | let newSnake = snake 36 | let newFood = food 37 | 38 | let frame = case action of 39 | MoveUp -> replicate height (replicate width (3,0,0)) 40 | MoveDown -> replicate height (replicate width (0,3,0)) 41 | MoveLeft -> replicate height (replicate width (0,0,3)) 42 | MoveRight -> replicate height (replicate width (3,3,3)) 43 | 44 | sendFrame (scale zoom frame) 45 | 46 | wait 47 | go (State action newSnake newFood) 48 | 49 | initialState :: IO State 50 | initialState = do 51 | let startSnake = [(15,15),(14,15)] 52 | let food = (28,28) 53 | return (State MoveRight startSnake food) 54 | 55 | charToAction :: Char -> Action -> Action 56 | charToAction c oldAction = case c of 57 | 'w' -> MoveUp 58 | 'a' -> MoveLeft 59 | 's' -> MoveDown 60 | 'd' -> MoveRight 61 | _ -> oldAction 62 | 63 | scale :: Int -> Frame -> Frame 64 | scale z frame = concatMap (replicate z) (map (concatMap (replicate z)) frame) 65 | -------------------------------------------------------------------------------- /SnakeFinished.hs: -------------------------------------------------------------------------------- 1 | import System.Random 2 | import GifStream 3 | 4 | -- Stopping focus of the browser tab stops the animation. Reload the page to fix it. 5 | 6 | type Position = (Int,Int) 7 | 8 | data Action = MoveLeft | MoveRight | MoveUp | MoveDown deriving Eq 9 | 10 | data State = State 11 | { oldAction :: Action 12 | , snake :: [Position] 13 | , food :: Position 14 | } 15 | 16 | -- 30000 seems to be the lowest value that works in Firefox 17 | -- 30 ms => 33 fps 18 | delay = 100000 -- in µs 19 | port = 5002 20 | 21 | width = 32 22 | height = 32 23 | zoom = 4 24 | 25 | main :: IO () 26 | main = server port delay logic 27 | 28 | logic :: IO () -> IO Char -> (Frame -> IO ()) -> IO () 29 | logic wait getInput sendFrame = initialState >>= go 30 | where 31 | go (State oldAction snake food) = do 32 | input <- getInput 33 | 34 | -- Generate new state 35 | let action = validateAction oldAction (charToAction input oldAction) -- Aufgabe 2 36 | 37 | let newSnake = moveSnake snake food action -- Aufgabe 2 38 | 39 | newFood <- moveFood newSnake food -- Aufgabe 3 40 | 41 | let frame = map (map (colorize newSnake newFood)) fieldPositions -- Aufgabe 1 42 | 43 | sendFrame (scale zoom frame) 44 | 45 | wait 46 | if checkGameOver newSnake -- Aufgabe 4 47 | then initialState >>= go 48 | else go (State action newSnake newFood) 49 | 50 | initialState :: IO State 51 | initialState = do 52 | let startSnake = [(15,15),(14,15)] 53 | let food = (28,28) 54 | return (State MoveRight startSnake food) 55 | 56 | charToAction :: Char -> Action -> Action 57 | charToAction c oldAction = case c of 58 | 'w' -> MoveUp 59 | 'a' -> MoveLeft 60 | 's' -> MoveDown 61 | 'd' -> MoveRight 62 | _ -> oldAction 63 | 64 | scale :: Int -> Frame -> Frame 65 | scale z frame = concatMap (replicate z) (map (concatMap (replicate z)) frame) 66 | 67 | -- Aufgabe 1 68 | 69 | fieldPositions :: [[Position]] 70 | fieldPositions = splitEvery width [(x,y) | y <- [0..height-1], x <- [0..width-1]] 71 | 72 | splitEvery :: Int -> [e] -> [[e]] 73 | splitEvery i ls 74 | | length ys > i = xs : splitEvery i ys 75 | | otherwise = [xs,ys] 76 | where (xs,ys) = splitAt i ls 77 | 78 | colorize :: [Position] -> Position -> Position -> RGB 79 | colorize snake food x 80 | | x `elem` snake = (3,3,3) 81 | | x == food = (3,0,0) 82 | | otherwise = (1,1,1) 83 | 84 | -- Aufgabe 2 85 | 86 | moveSnake :: [Position] -> Position -> Action -> [Position] 87 | moveSnake xs@((x,y):_) food action = newHead : newTail 88 | where newHead = case action of 89 | MoveLeft -> (x-1,y) 90 | MoveRight -> (x+1,y) 91 | MoveUp -> (x,y-1) 92 | MoveDown -> (x,y+1) 93 | newTail = if newHead == food then xs 94 | else init xs 95 | 96 | validateAction :: Action -> Action -> Action 97 | validateAction oldAction action = if opposite action == oldAction then oldAction else action 98 | 99 | opposite :: Action -> Action 100 | opposite MoveLeft = MoveRight 101 | opposite MoveRight = MoveLeft 102 | opposite MoveUp = MoveDown 103 | opposite MoveDown = MoveUp 104 | 105 | -- Aufgabe 3 106 | 107 | moveFood :: [Position] -> Position -> IO Position 108 | moveFood (x:xs) food 109 | | x == food = getRandomOutside (x:xs) 110 | | otherwise = return food 111 | 112 | getRandomOutside :: [Position] -> IO Position 113 | getRandomOutside xs = do 114 | fx <- randomRIO (0, width - 1) 115 | fy <- randomRIO (0, height - 1) 116 | 117 | if (fx,fy) `elem` xs 118 | then getRandomOutside xs 119 | else return (fx,fy) 120 | 121 | -- Aufgabe 4 122 | 123 | checkGameOver :: [Position] -> Bool 124 | checkGameOver ((x,y):xs) = (x,y) `elem` xs 125 | || x < 0 || x >= width 126 | || y < 0 || y >= height 127 | -------------------------------------------------------------------------------- /listmonster.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/def-/gifstream/1caaee3d060e9e38c1c3816afc0fd9ce94f651c7/listmonster.png -------------------------------------------------------------------------------- /snake.cabal: -------------------------------------------------------------------------------- 1 | Name: snake 2 | Version: 0.1 3 | Copyright: BSD3 4 | License: BSD3 5 | License-File: LICENSE 6 | Build-Type: Simple 7 | Cabal-Version: >= 1.2 8 | Maintainer: Dennis Felsing 9 | 10 | Executable snake 11 | Main-is: SnakeFinished.hs 12 | Other-modules: GifStream 13 | 14 | -- All in Haskell Platform 15 | Build-Depends: base, bytestring, network, random 16 | 17 | Extensions: DoAndIfThenElse 18 | -------------------------------------------------------------------------------- /snake.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/def-/gifstream/1caaee3d060e9e38c1c3816afc0fd9ce94f651c7/snake.gif -------------------------------------------------------------------------------- /snake.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/def-/gifstream/1caaee3d060e9e38c1c3816afc0fd9ce94f651c7/snake.png --------------------------------------------------------------------------------