{- Graphics functions for visualizing the Snake game. Copyright (C) 2020 Max Schröder This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . The graphics are inspired by Nokia's Snake. There is a game board which is surrounded by a border. At the top, the current score is displayed. Initially, the score is 0 and it is incremented by one when the snake eats. The body parts of the snake are pixelated to look similar to the Nokia game. The term "pixel" in this code does not refer to a real screen pixel but it is rather a simulated pixel to achieve a retro effect. In reality, it consists of multiple real pixels with the same color. This module exports the following functions: - generateVideo: Generates a video from multiple images. - stateToImage: Generates an image from a game state. -} module Wettbewerb.Graphics (generateVideo, stateToImage) where import Prelude hiding (Either(..)) import Data.Sequence (Seq(Empty, (:|>))) import Codec.Picture.Types (Image(imageWidth, imageHeight), PixelRGB8(PixelRGB8), MutableImage, writePixel, createMutableImage, freezeImage) import Codec.FFmpeg (EncodingParams(EncodingParams)) import Codec.FFmpeg.Juicy (imageWriter) import Control.Monad (when) import Control.Monad.ST (RealWorld) import Wettbewerb.Types (State(..), parts, Board, Position, Direction(..), whichDirection) {- - - - - - - - - - - - Hard-coded values - - - - - - - - - - - -} -- default sizes pixel, cellSize, padding, border, digitHeight, digitWidth, offsetX, offsetY :: Int pixel = 16 -- size of a simulated "pixel" as described in the module description cellSize = 4 * pixel padding = 2 * pixel border = pixel digitHeight = 5 * pixel digitWidth = 4 * pixel -- offset of the game board in the image offsetX = padding + border offsetY = 3 * padding + 2 * border + digitHeight -- functions to calculate the full width/height of the image from the width/height of the game board fullWidth, fullHeight :: Int -> Int fullWidth width = width + 2 * border + 2 * padding fullHeight height = height + 3 * border + 4 * padding + digitHeight -- default colors backgroundColor, foregroundColor :: PixelRGB8 backgroundColor = PixelRGB8 154 197 3 foregroundColor = PixelRGB8 0 0 0 -- hard-coded pixels of the individual snake parts (depending on the direction in which the part -- is moving) middlePart :: Direction -> [(Int, Int)] middlePart Left = [(0,2), (1,2), (3,2), (0,1), (2,1), (3,1)] middlePart Up = [(1,0), (2,0), (1,1), (2,2), (1,3), (2,3)] middlePart Right = [(0,1), (1,1), (3,1), (0,2), (2,2), (3,2)] middlePart Down = [(2,0), (1,0), (2,1), (1,2), (2,3), (1,3)] headPart :: Direction -> [(Int, Int)] headPart Left = [(3,0), (1,1), (2,1), (1,2), (2,2), (3,2)] headPart Up = [(0,3), (2,3), (1,1), (2,1), (1,2), (2,2)] headPart Right = [(0,0), (2,1), (1,1), (2,2), (1,2), (0,2)] headPart Down = [(0,0), (2,0), (1,1), (2,1), (1,2), (2,2)] tailPart :: Direction -> [(Int, Int)] tailPart Left = [(0,1), (1,1), (0,2), (1,2), (2,2), (3,2)] tailPart Up = [(1,0), (2,0), (1,1), (2,1), (2,2), (2,3)] tailPart Right = [(2,1), (3,1), (0,2), (1,2), (2,2), (3,2)] tailPart Down = [(2,0), (2,1), (1,2), (2,2), (1,3), (2,3)] cornerPart :: Direction -> Direction -> [(Int, Int)] cornerPart Left Up = [(3,2), (2,2), (3,1), (1,1), (2,0), (1,0)] cornerPart Left Down = [(3,1), (2,1), (3,2), (1,2), (2,3), (1,3)] cornerPart Right Up = [(0,2), (1,2), (0,1), (2,1), (1,0), (2,0)] cornerPart Right Down = [(0,1), (1,1), (0,2), (2,2), (1,3), (2,3)] cornerPart Up Left = cornerPart Right Down cornerPart Up Right = cornerPart Left Down cornerPart Down Left = cornerPart Right Up cornerPart Down Right = cornerPart Left Up -- Hard-coded pixels of a piece of food. -- If you did not notice, this should be a lambda :) foodPixels :: [(Int, Int)] foodPixels = [(1,1), (2,2), (1,3), (3,3)] -- hard-coded pixels of the individual digits for the score digit :: Int -> [(Int, Int)] digit 0 = [(0,0), (1,0), (2,0), (0,1), (2,1), (0,2), (2,2), (0,3), (2,3), (0,4), (1,4), (2,4)] digit 1 = [(2,0), (1,1), (2,1), (2,2), (2,3), (2,4)] digit 2 = [(0,0), (1,0), (2,0), (2,1), (0,2), (1,2), (2,2), (0,3), (0,4), (1,4), (2,4)] digit 3 = [(0,0), (1,0), (2,0), (2,1), (0,2), (1,2), (2,2), (2,3), (0,4), (1,4), (2,4)] digit 4 = [(0,0), (2,0), (0,1), (2,1), (0,2), (1,2), (2,2), (2,3), (2,4)] digit 5 = [(0,0), (1,0), (2,0), (0,1), (0,2), (1,2), (2,2), (2,3), (0,4), (1,4), (2,4)] digit 6 = [(0,0), (1,0), (2,0), (0,1), (0,2), (1,2), (2,2), (0,3), (2,3), (0,4), (1,4), (2,4)] digit 7 = [(0,0), (1,0), (2,0), (2,1), (1,2), (1,3), (0,4)] digit 8 = [(0,0), (1,0), (2,0), (0,1), (2,1), (0,2), (1,2), (2,2), (0,3), (2,3), (0,4), (1,4), (2,4)] digit 9 = [(0,0), (1,0), (2,0), (0,1), (2,1), (0,2), (1,2), (2,2), (2,3), (0,4), (1,4), (2,4)] {- - - - - - - - - - - - - Exported functions - - - - - - - - - - - - -} -- Generates a video from multiple images. -- All images should have the same width and height. generateVideo :: [Image PixelRGB8] -- list of images -> Int -- frames per second -> String -- output path -> IO () generateVideo [] fps path = error "Provide at least one image to generate a video!" generateVideo imgs@(fstImg : _) fps path = do writer <- imageWriter params path -- open output stream mapM_ (writer . Just) imgs -- write images to output stream writer Nothing -- close output stream where -- infer width and height from first image width = fromIntegral (imageWidth fstImg) height = fromIntegral (imageHeight fstImg) -- infer codec, pixel format and muxer format from output file name and use default preset params = EncodingParams width height fps Nothing Nothing "medium" Nothing -- Generates an image from a state. stateToImage :: Board -- board dimensions -> State -- state -> Int -- initial length of the snake -> IO (Image PixelRGB8) -- generated image stateToImage (w, h) state initialSnakeLength = do let foodPos = foodPosition state snakeParts = parts (snake state) width = w * cellSize height = h * cellSize score = length snakeParts - initialSnakeLength -- create empty image and draw border, score, food and snake image <- createMutableImage (fullWidth width) (fullHeight height) backgroundColor drawBorders image width height drawScore image score -- only draw food if the game is not over yet when (foodPos `notElem` snakeParts) $ drawPixels image foodPos foodPixels drawSnake image state snakeParts freezeImage image {- - - - - - - - - - Basic drawing - - - - - - - - - -} -- (startX, startY, endX, endY) type Bounds = (Int, Int, Int, Int) -- Determines bounds of an object from start position and dimensions. toBounds :: Position -> Int -> Int -> Bounds toBounds (x, y) width height = (x, y, x + width - 1, y + height - 1) -- Fills a rectangle in an image with the specified bounds and color. fillRectangle :: MutableImage RealWorld PixelRGB8 -> Bounds -> PixelRGB8 -> IO () fillRectangle image (startX, startY, endX, endY) color = mapM_ (\(x, y) -> writePixel image x y color) [(x, y) | x <- [startX..endX], y <- [startY..endY]] -- Draws the specified pixels to a certain cell. drawPixels :: MutableImage RealWorld PixelRGB8 -- image -> Position -- absolute position of the cell on the game board -> [Position] -- relative positions of the pixels in the cell -> IO () drawPixels image (cellX, cellY) = mapM_ (\(relX, relY) -> fillRectangle image (toBounds (offsetX + cellX * cellSize + pixel * relX, offsetY + cellY * cellSize + pixel * relY) pixel pixel) foregroundColor) {- - - - - - - - - - - - - - - - - - Drawing of specific elements - - - - - - - - - - - - - - - - - -} -- Draws the borders of the game board. drawBorders :: MutableImage RealWorld PixelRGB8 -> Int -> Int -> IO () drawBorders image width height = mapM_ (\(x, y, width, height) -> fillRectangle image (toBounds (x, y) width height) foregroundColor) [(padding, 2 * padding + digitHeight, width + 2 * border, border), (padding, 3 * padding + digitHeight + border, width + 2 * border, border), (padding, 3 * padding + digitHeight + 2 * border + height, width + 2 * border, border), (padding, 3 * padding + digitHeight + 2 * border, border, height), (padding + border + width, 3 * padding + digitHeight + 2 * border, border, height)] -- Draws the score (always four digits). drawScore :: MutableImage RealWorld PixelRGB8 -> Int -> IO () drawScore image score = mapM_ (\i -> drawDigit image ((score `div` (10 ^ (3 - i))) `mod` 10) (i * digitWidth)) [0..3] -- Draws a digit. drawDigit :: MutableImage RealWorld PixelRGB8 -> Int -> Int -> IO () drawDigit image dig marginLeft = mapM_ (\(x, y) -> fillRectangle image (toBounds (2 * padding + marginLeft + pixel * x, padding + pixel * y) pixel pixel) foregroundColor) (digit dig) -- Draws the snake. drawSnake :: MutableImage RealWorld PixelRGB8 -- image -> State -- current state -> Seq Position -- snake parts -> IO () drawSnake image state = drawSnake' Nothing where -- Draws the snake recursively, from the tail to the head. drawSnake' :: Maybe Direction -- direction of the previous snake part or Nothing if the -- current snake part is the tail -> Seq Position -- snake parts that still have to be drawn -> IO () drawSnake' mPrevDir (ps :|> nextPos :|> pos) = do let mDir = Just (whichDirection pos nextPos) -- draw snake part and remaining snake drawSnakePart image pos mPrevDir mDir (direction state) drawSnake' mDir (ps :|> nextPos) drawSnake' mPrevDir (Empty :|> pos) = -- draw head of the snake drawSnakePart image pos mPrevDir Nothing (direction state) -- Draws a snake part. drawSnakePart :: MutableImage RealWorld PixelRGB8 -> Position -- position of the snake part -> Maybe Direction -- direction of the previous snake part or Nothing if the -- current snake part is the tail -> Maybe Direction -- direction of this snake part or Nothing if the current -- snake part is the head -> Direction -- last direction in which the snake has moved -> IO () drawSnakePart image pos mPrevDir mDir stateDir = drawPixels image pos pixels where -- pixels for this snake part pixels = case (mPrevDir, mDir) of (Nothing, Just dir) -> tailPart dir (_, Nothing) -> headPart stateDir (Just prevDir, Just dir) -> if prevDir == dir then middlePart dir else cornerPart prevDir dir