packages feed

hexmino (empty) → 0.1.0.0

raw patch · 15 files changed

+1279/−0 lines, 15 filesdep +basedep +containersdep +directorysetup-changed

Dependencies added: base, containers, directory, filepath, gloss, optparse-applicative, random

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, pasqu4le++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of pasqu4le nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,41 @@+# Hexmino+Hexmino is a small game where you have to put domino-like hexagonal tiles into a grid in as little time as possible.++![screenshot](screenshot.png)++This game was written in haskell mostly as an experiment in the use of the [gloss library](https://hackage.haskell.org/package/gloss).++## Installation+> Note: You may need to install [freeglut](https://www.archlinux.org/packages/extra/x86_64/freeglut/) or [glfw](https://www.archlinux.org/packages/community/x86_64/glfw/) for hexmino to work, for more info see the [gloss website](http://gloss.ouroborus.net/).++For ArchLinux the binary from [the latest github release](https://github.com/pasqu4le/hexmino/releases/latest) should work.+For other Linux distro the binary may work as well, or you can build from source.++You can build from source using [cabal-install](http://hackage.haskell.org/package/cabal-install).+Since hexmino is on Hackage you can just use:++```+$ cabal install hexmino+```+or install from the cloned repository:+```+$ git clone https://github.com/pasqu4le/hexmino.git+$ cd hexmino+$ cabal install+```++## How to play+Once you selected a difficulty level and started the game you can drag and drop tiles from the queue on the right onto the grid.+You can rotate the tile you are dragging by pressing the spacebar.++The game ends when (and if) the grid is full and every tile on the grid matches with it's neighbours with each of it's faces.++The better your time, the better your position in the leaderboard.++## Command line arguments+You can only select the frames per second used in the game using `--fps` or `-f`, for example: `hexmino --fps 120`. If you don't specify it defaults to 60 fps.++## TODOs+- better text rendering (both in quality and performance), maybe using a font+- background music+- widgets animations
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hexmino.cabal view
@@ -0,0 +1,88 @@+-- Initial hexmino.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                hexmino++-- The package version.  See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- https://wiki.haskell.org/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            A small game based on domino-like hexagonal tiles++-- A longer description of the package.+description:         Hexmino is a small game where you have to put domino-like hexagonal tiles into a grid in as little time as possible++-- URL for the project homepage or repository.+homepage:            https://github.com/pasqu4le/hexmino++-- The license under which the package is released.+license:             BSD3++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              pasqu4le++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer:          pasqu4le@gmail.com++-- A copyright notice.+-- copyright:++category:            Game++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+extra-source-files:  README.md++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type:              git+  location:          git://github.com/pasqu4le/hexmino.git++executable hexmino+  ghc-options:         -O2 -threaded+  -- .hs or .lhs file containing the Main module.+  main-is:             Main.hs++  -- Modules included in this executable, other than Main.+  other-modules:       Game+                       Selection+                       Table+                       TileGrid+                       TileList+                       Tile+                       Hex+                       Widgets+                       Options+                       Score++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:++  -- Other library packages from which modules are imported.+  build-depends:       base >=4.11 && <4.12,+                       gloss >=1.12 && <1.13,+                       containers >=0.5.10 && <0.5.12,+                       random >=1.1 && <1.2,+                       optparse-applicative >=0.14 && <0.15,+                       directory >= 1.3 && <1.4,+                       filepath >= 1.3 && <1.5++  -- Directories containing source files.+  hs-source-dirs:      src++  -- Base language which the package is written in.+  default-language:    Haskell2010
+ src/Game.hs view
@@ -0,0 +1,216 @@+module Game where++import qualified Options as Opts+import qualified Selection as Sel+import qualified Table+import qualified Widgets as Wid+import qualified Score++import Data.Function (on)+import qualified System.Random as Rand+import qualified System.Exit as Exit+import qualified Graphics.Gloss as Gloss+import qualified Graphics.Gloss.Data.Color as Color+import qualified Graphics.Gloss.Data.Picture as Pict+import qualified Graphics.Gloss.Data.Point.Arithmetic as PArith+import Graphics.Gloss.Interface.IO.Game (playIO, Event(..), Key(..), SpecialKey(..), KeyState(..), MouseButton(..), Modifiers(..))++data State = State {+    status :: GameStatus,+    score :: Score.Score,+    topTen :: Score.Leaderboard,+    gameTable :: Table.Table,+    selection :: Maybe Sel.Selection,+    winScale :: Float+  }+data GameStatus = SplashScreen | Running | Complete | Info deriving (Show, Eq)++-- scaling from this; NOTE: Game keeps track of window scaling, everything else will assume no scaling+standardSize :: (Int, Int)+standardSize = (700, 480)++scalePoint :: Pict.Point -> Float -> Pict.Point+scalePoint point factor = (1/factor) PArith.* point++-- entry point+run :: Opts.Options -> IO ()+run opts = do+  gen <- Rand.getStdGen+  state <- initialState gen+  playIO window background (Opts.fps opts) state render handleEvent step++-- gloss-starting functions+window :: Gloss.Display+window = Gloss.InWindow "Hexmino" standardSize (50,50)++background :: Color.Color+background = Color.white++initialState :: Rand.StdGen -> IO State+initialState gen = do+  sc <- Score.readPlayer+  leaders <- Score.readTopTen+  return $ State {+    status = SplashScreen,+    score = sc,+    topTen = leaders,+    gameTable = Table.empty gen,+    selection = Nothing,+    winScale = 1+  }++-- rendering functions+render :: State -> IO Pict.Picture+render st = returnScaled st . (Table.render (gameTable st) :) $ case status st of+  SplashScreen -> [Wid.renderBanner, Wid.renderGameSelector $ score st, Wid.renderTopTen $ topTen st, Wid.renderInfoButton]+  Running -> [Wid.renderTime $ score st, renderSelection st, Wid.renderCloseGame]+  Complete -> [Wid.renderCompleted $ score st, Wid.renderNameSelector $ score st, Wid.renderTopTen $ topTen st]+  Info -> [Wid.renderBanner, Wid.renderInfo, Wid.renderTopTen $ topTen st]++returnScaled :: State -> [Pict.Picture] -> IO Pict.Picture+returnScaled st = return . Pict.scale (winScale st) (winScale st) . Pict.pictures++renderSelection :: State -> Pict.Picture+renderSelection st = case selection st of+  Just sel -> Sel.render sel+  _ -> Pict.Blank++-- event handling / state changing+handleEvent :: Event -> State -> IO State+handleEvent (EventKey (SpecialKey KeyEsc) Up _ _) _ = Exit.exitSuccess+handleEvent (EventResize newSize) state = return $ changeScale newSize state+handleEvent ev st = let se = scaledEvent ev (winScale st) in case status st of+  SplashScreen -> handleSplash se st+  Running -> handleRunning se st+  Complete -> handleComplete se st+  Info -> handleInfo se st++scaledEvent :: Event -> Float ->  Event+scaledEvent ev factor = case ev of+  EventKey k ks mods point -> EventKey k ks mods $ scalePoint point factor+  EventMotion point -> EventMotion $ scalePoint point factor+  _ -> ev  ++changeScale :: (Int, Int) -> State -> State+changeScale (w, h) state = state {winScale = newScale}+  where +    (dw, dh) = standardSize+    newScale = min (floatDiv w dw) (floatDiv h dh)++handleSplash :: Event -> State -> IO State+handleSplash (EventKey k ks _ pos) st = case (k, ks) of+  (SpecialKey KeyEnter, Up) -> return $ newGame st+  (SpecialKey KeyRight, Up) -> return $ st {score = Score.toNextLevel $ score st}+  (SpecialKey KeyLeft, Up) -> return $ st {score = Score.toPreviousLevel $ score st}+  (Char 'i', Up) -> return $ st {status = Info} +  (MouseButton LeftButton, Up) -> handleWidgetClick pos st+  _ -> return st+handleSplash _ st = return st++handleInfo :: Event -> State -> IO State+handleInfo (EventKey k ks _ pos) st = case (k, ks) of+  (SpecialKey KeyEnter, Up) -> return $ st {status = SplashScreen}+  (MouseButton LeftButton, Up) -> handleWidgetClick pos st+  _ -> return st +handleInfo _ st = return st++handleComplete :: Event -> State -> IO State+handleComplete (EventKey k ks m pos) st = case (k, ks) of+  (SpecialKey KeyEnter, Up) -> submitScore st+  (SpecialKey KeyDelete, Up) -> return $ st {score = Score.delFromName $ score st}+  (Char '\x0008', Up) -> return $ st {score = Score.delFromName $ score st}+  (Char c, Up) -> return $ st {score = Score.addToName c $ score st}+  (MouseButton LeftButton, Up) -> handleWidgetClick pos st+  _ -> return st +handleComplete _ st = return st++handleWidgetClick :: Pict.Point -> State -> IO State+handleWidgetClick pos st = case Wid.findClicked pos . buttonsInStatus $ status st of+  Just name -> handleEvent (EventKey (keyFromWidget name) Up noMod (0,0)) st+  _ -> return st++buttonsInStatus :: GameStatus -> [Wid.Name]+buttonsInStatus status = case status of+  SplashScreen -> [Wid.NewGame, Wid.LeftArrow, Wid.RightArrow, Wid.Info]+  Running -> [Wid.CloseGame]+  Complete -> [Wid.Delete, Wid.Submit]+  Info -> [Wid.CloseInfo]++keyFromWidget :: Wid.Name -> Key+keyFromWidget name = case name of+  Wid.NewGame -> SpecialKey KeyEnter+  Wid.LeftArrow -> SpecialKey KeyLeft+  Wid.RightArrow -> SpecialKey KeyRight+  Wid.Delete -> SpecialKey KeyDelete+  Wid.Submit -> SpecialKey KeyEnter+  Wid.CloseInfo -> SpecialKey KeyEnter+  Wid.CloseGame -> Char '\x0008'+  Wid.Info ->  Char 'i'+  _ -> SpecialKey KeyEsc -- something went wrong here++submitScore :: State -> IO State+submitScore st = do +  leaders <- Score.submit $ score st+  return $ st {status = SplashScreen, topTen = leaders}++handleRunning :: Event -> State -> IO State+handleRunning (EventKey k ks _ pos) = case (k, ks) of+  (SpecialKey KeySpace, Up) -> return . rotateSelection+  (Char '\x0008', Up) -> return . backToSpashScreen+  (MouseButton LeftButton, Down) -> return . grabSelection pos+  (MouseButton LeftButton, Up) -> handleRunningClick pos+  _ -> return+handleRunning (EventMotion pos) = return . dragSelection pos+handleRunning _ = return++backToSpashScreen :: State -> State+backToSpashScreen st = st {status = SplashScreen, gameTable = Table.clear $ gameTable st}++handleRunningClick :: Pict.Point -> State -> IO State+handleRunningClick pos st = case selection st of+  Just sel -> return $ dropSelection pos st+  _ -> handleWidgetClick pos st++rotateSelection :: State -> State+rotateSelection st = st {selection = Sel.rotate <$> selection st}++dragSelection :: Pict.Point -> State -> State+dragSelection pos st = st {selection = Sel.moveTo pos <$> selection st}++grabSelection :: Pict.Point -> State -> State+grabSelection pos st = st {gameTable = newTable, selection = Sel.make <$> newTile}+  where (newTable, newTile) = Table.grab pos $ gameTable st++dropSelection :: Pict.Point -> State -> State+dropSelection point st = case selection st of+  Just sel -> checkCompleted $ st {gameTable = Table.putTile (Sel.tile sel) point $ gameTable st, selection = Nothing}+  _ -> st++newGame :: State -> State+newGame state = state {+    status = Running, +    gameTable = Table.newGame (Score.levelNum $ score state) $ gameTable state,+    score = Score.clearTime $ score state+  }++checkCompleted :: State -> State+checkCompleted state+  | Table.isCompleted table = state {status = Complete, gameTable = Table.clear table}+  | otherwise = state+  where table = gameTable state++-- stepping+step :: Float -> State -> IO State+step secs st = return $ st {+    gameTable = Table.step secs $ gameTable st,+    selection = Sel.step secs <$> selection st,+    score = stepTime $ score st+  }+  where stepTime = if status st == Running then Score.step secs else id++-- utils+floatDiv :: Int -> Int -> Float+floatDiv = (/) `on` fromIntegral++noMod :: Modifiers+noMod = Modifiers {shift = Up, ctrl = Up, alt = Up}
+ src/Hex.hs view
@@ -0,0 +1,150 @@+module Hex where++import Data.Char (toUpper)+import qualified Graphics.Gloss.Data.Picture as Pict++data Hexagon = Hexagon {center :: Pict.Point, radius :: Float} deriving (Show)++-- rendering functions+render :: Hexagon -> Pict.Picture+render hex = Pict.translate x y $ renderCentered hex+  where (x, y) = center hex++renderCentered :: Hexagon -> Pict.Picture+renderCentered = hexagonSolid . radius++hexagonSolidPointy :: Float -> Pict.Picture+hexagonSolidPointy = Pict.rotate 30 . hexagonSolid++hexagonSolid :: Float -> Pict.Picture+hexagonSolid = Pict.polygon . hexagonPath++hexagonPath :: Float -> Pict.Path+hexagonPath r = [(-r, 0), (-rx, ry), (rx, ry), (r, 0), (rx, -ry), (-rx, -ry)]+  where+    rx = r / 2+    ry = heightFromRadius r / 2++rectangleBlunt :: Float -> Float -> Pict.Picture+rectangleBlunt w h = Pict.polygon $ rectangleBluntPath w h++rectangleBluntLine :: Float -> Float -> Pict.Picture+rectangleBluntLine w h = Pict.line $ (x:xs) ++ [x]+  where (x:xs) = rectangleBluntPath w h++rectangleBluntPath :: Float -> Float -> Pict.Path+rectangleBluntPath w h = [(-sw,hh),(-hw,sh),(-hw,-sh),(-sw,-hh),(sw,-hh),(hw,-sh),(hw,sh),(sw,hh)]+  where+    c = w / 10+    hw = w / 2+    hh = h / 2+    sw = hw - c+    sh = hh - c++-- manupulation functions+moveTo :: Pict.Point -> Hexagon -> Hexagon+moveTo point hex = hex {center = point}++moveBy :: Pict.Point -> Hexagon -> Hexagon+moveBy (x, y) hex = hex {center = (cx+x, cy+y)}+  where (cx, cy) = center hex++-- utility functions+hexagonHeight :: Hexagon -> Float+hexagonHeight = heightFromRadius . radius++heightFromRadius :: Float -> Float+heightFromRadius = (* sqrt 3)++contains :: Pict.Point -> Hexagon -> Bool -- approximation, but good enough+contains pos hex+  | distanceFromCenter pos hex < hexagonHeight hex / 2 = True+  | otherwise = False++distanceFromCenter :: Pict.Point -> Hexagon -> Float+distanceFromCenter pnt Hexagon {center = cnt} = pointsDistance pnt cnt++pointsDistance :: Pict.Point -> Pict.Point -> Float+pointsDistance (x1,y1) (x2,y2) = sqrt $ (x1-x2) ** 2 + (y1-y2) ** 2++-- string (contained in a rectangle) and letter with hexagonal shape++hexagonText :: Float -> Float -> String -> Pict.Picture+hexagonText w h txt = Pict.scale fa 1 . Pict.translate offset 0 $ Pict.pictures letters+  where+    r = h / 3+    spacing = r * 2.5+    size = length txt+    letters = zipWith (`Pict.translate` 0) [0,spacing..] $ map (hexagonChar r) txt+    offset = (-spacing) * fromIntegral (size - 1) / 2+    fa = w / (fromIntegral size * r * 3)+++hexagonChar :: Float -> Char -> Pict.Picture+hexagonChar r letter = thickLine (r/4) $ case toUpper letter of+  'A' -> [sw, w, nw, ne, e, w, e, se]+  'B' -> [e, se, sw, nw, ne, e, c]+  'C' -> [ne, nw, w, sw, se] +  'D' -> [sw, nw, ne, e, se, sw]+  'E' -> [ne, nw, w, c, w, sw, se]+  'F' -> [ne, nw, w, c, w, sw]+  'G' -> [ne, nw, w, sw, se, e, c]+  'H' -> [nw, w, sw, w, e, ne, e, se]+  'I' -> [nw, ne, n, s, se, sw]+  'J' -> [ne, e, se, sw, w]+  'K' -> [nw, w, sw, w, ne, w, se]+  'L' -> [nw, w, sw, se]+  'M' -> [sw, w, nw, c, ne, e, se]+  'N' -> [sw, w, nw, se, e, ne]+  'O' -> [w, nw, ne, e, se, sw, w]+  'P' -> [sw, w, nw, ne, e, w]+  'Q' -> [se, sw, w, nw, ne, e, se, c]+  'R' -> [sw, w, nw, ne, e, w, c, se]+  'S' -> [ne, nw, w, e, se, sw]+  'T' -> [s, n, nw, w, nw, ne, e]+  'U' -> [nw, w, sw, se, e, ne] +  'V' -> [nw, w, s, e, ne]+  'W' -> [nw, w, sw, c, se, e, ne]+  'X' -> [nw, se, c, ne, sw]+  'Y' -> [nw, c, s, c, ne]+  'Z' -> [w, nw, ne, sw, se, e]+  '0' -> [nw, w, sw, se, e, ne, nw, se]+  '1' -> [nw, n, s]+  '2' -> [w, nw, ne, e, sw, se]+  '3' -> [nw, ne, c, e, se, sw]+  '4' -> [nw, w, e, ne, e, se]+  '5' -> [ne, nw, c, e, se, sw]+  '6' -> [ne, nw, w, e, se, sw, w]+  '7' -> [w, nw, ne, sw]+  '8' -> [c, nw, ne, c, e, se, sw, w, c]+  '9' -> [sw, se, e, ne, nw, w, e]+  '>' -> [nw, c, sw]+  '<' -> [ne, c, se]+  '_' -> [sw, se]+  '/' -> [sw, ne]+  '?' -> [w, nw, ne, e, c, s]+  ' ' -> []+  _ -> [ne, e, w, sw, ne]+  where+    [w, nw, ne, e, se, sw] = hexagonPath r+    c = (0,0)+    ry = heightFromRadius r / 2+    n = (0, ry)+    s = (0, -ry)++thickLine :: Float -> Pict.Path -> Pict.Picture+thickLine t = Pict.pictures . thickSegments t++thickSegments :: Float -> Pict.Path -> [Pict.Picture]+thickSegments t (a:b:xs) = Pict.polygon (thickSegmentPath t a b) : thickSegments t (b:xs)+thickSegments _ _ = []++thickSegmentPath :: Float -> Pict.Point -> Pict.Point -> Pict.Path+thickSegmentPath t (ax, ay) (bx, by)+  | abs dx >= abs dy && dx >= 0 = [(ax, ay+r),(ax-r, ay),(ax, ay-r),(bx, by-r),(bx+r, by),(bx, by+r)]+  | abs dx >= abs dy = [(ax, ay+r),(ax+r, ay),(ax, ay-r),(bx, by-r),(bx-r, by),(bx, by+r)]+  | dy >= 0 = [(ax-r, ay),(ax, ay-r),(ax+r, ay),(bx+r, by),(bx, by+r),(bx-r, by)]+  | otherwise = [(ax-r, ay),(ax, ay+r),(ax+r, ay),(bx+r, by),(bx, by-r),(bx-r, by)]+  where+    (dx, dy) = (bx - ax, by - ay)+    r = t / 2
+ src/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import qualified Game+import qualified Options as Opts++-- only an entry point+main :: IO ()+main = Game.run =<< Opts.getOptions
+ src/Options.hs view
@@ -0,0 +1,24 @@+module Options where++import Options.Applicative+import Data.Semigroup ((<>))++newtype Options = Options {fps :: Int}++-- argument parsing+getOptions :: IO Options+getOptions = execParser $ info (opts <**> helper) (+    fullDesc+    <> header "Hexmino: put the hex-tiles in the grid as fast as possible"+    <> progDesc "A small game based on domino-like hexagonal tiles"+  )++opts :: Parser Options+opts = Options+  <$> option auto+    ( long "fps"+    <> short 'f'+    <> metavar "INT"+    <> help "Frames per second"+    <> showDefault+    <> value 60)
+ src/Score.hs view
@@ -0,0 +1,123 @@+module Score where++import Text.Printf (printf)+import Data.List (intercalate, sort)+import Data.Char (isLetter)+import qualified System.Directory as Dir+import System.FilePath ((</>))++data Score = Score {player :: String, level :: Level, time :: Float} deriving (Show, Read, Eq)+data Level = Beginner | Average | Expert deriving (Show, Read, Eq, Enum, Bounded)+type Leaderboard = [Score]++instance Ord Score where+  compare sc1 sc2+    | level sc1 /= level sc2 = compare (level sc1) (level sc2)+    | otherwise = compare (time sc1) (time sc2)++instance Ord Level where+  compare lv1 lv2 = compare (fromEnum lv2) (fromEnum lv1)++-- creation+readPlayer :: IO Score+readPlayer = do+  dataDir <- dataDirectory+  let filePath = dataDir </> "player"+  exists <- Dir.doesFileExist filePath+  if exists then+    read <$> readFile filePath+  else+    return $ Score {player = "PAS", level = Beginner, time = 0}++readTopTen :: IO Leaderboard+readTopTen = take 10 <$> readLeaderboard++-- manipulation+clearTime :: Score -> Score+clearTime score = score {time = 0}++delFromName :: Score -> Score+delFromName score = score {player = init $ player score}++addToName :: Char -> Score -> Score+addToName c score+  | isLetter c = score {player = take 2 (player score) ++ [c]} +  | otherwise = score++submit :: Score -> IO Leaderboard+submit score = do+  dataDir <- dataDirectory+  let playerPath = dataDir </> "player"+      leaderPath = dataDir </> "leaderboard"+      newLeaderPath = dataDir </> "leaderboard.new"+  writeFile playerPath . show $ clearTime score+  leaders <- readLeaderboard+  let newLeaders = sort (score:leaders)+  writeFile newLeaderPath . unlines $ map show newLeaders+  Dir.renameFile newLeaderPath leaderPath+  return $ take 10 newLeaders++-- persistency+dataDirectory :: IO FilePath+dataDirectory = do+  dataDir <- Dir.getXdgDirectory Dir.XdgData "hexmino"+  Dir.createDirectoryIfMissing True dataDir+  return dataDir++readLeaderboard :: IO Leaderboard+readLeaderboard = do+  dataDir <- dataDirectory+  let filePath = dataDir </> "leaderboard"+  exists <- Dir.doesFileExist filePath+  if exists then do+    info <- readFile filePath+    let (name:lvl:_) = words info+    map read . lines <$> readFile filePath+  else+    return [Score {player = "PAS", level = Expert, time = 2520}]++-- stepping+step :: Float -> Score -> Score+step secs score = score {time = secs + time score}++-- utility+display :: Score -> String+display score = unwords [+    player score, +    secsToString $ time score, +    levelShort $ level score+  ]++levelNum :: Score -> Int+levelNum = (1+) . fromEnum . level++toNextLevel :: Score -> Score+toNextLevel score+  | level score == maxBound = score+  | otherwise = score {level = succ $ level score}++toPreviousLevel :: Score -> Score+toPreviousLevel score+  | level score == minBound = score+  | otherwise = score {level = pred $ level score}++levelShort :: Level -> String+levelShort lvl = case lvl of+  Beginner -> "B"+  Average -> "A"+  Expert -> "X"++showTime :: Score -> String+showTime = secsToString . time++secsToString :: Float -> String+secsToString secs = intercalate "/" vals+  where+    s = floor secs :: Int+    vals = map (printf "%02d" . (`mod` 60)) [s `div` 3600, s `div` 60, s]++isMinLevel :: Level -> Bool+isMinLevel lvl = lvl == minBound++isMaxLevel :: Level -> Bool+isMaxLevel lvl = lvl == maxBound
+ src/Selection.hs view
@@ -0,0 +1,32 @@+module Selection where++import qualified Tile+import qualified Graphics.Gloss.Data.Picture as Pict++-- a selection is a tile that is currently controlled by the user+data Selection = Selection {tile :: Tile.Tile, rotation :: Maybe Float}++-- creation+make :: Tile.Tile -> Selection+make t = Selection {tile = t, rotation = Nothing}++-- rendering+render :: Selection -> Pict.Picture+render sel = case rotation sel of+  Just rot -> Tile.renderRotated rot $ tile sel+  _ -> Tile.render $ tile sel++-- manupulation functions+rotate :: Selection -> Selection+rotate sel = sel {rotation = Just 0} -- only starts the rotation, needs to be stepped++moveTo :: Pict.Point -> Selection -> Selection+moveTo pos sel = sel {tile = Tile.moveTo pos $ tile sel}++-- stepping+step :: Float -> Selection -> Selection+step secs sel = case rotation sel of+  Just rot -> let newRot = rot + secs * 1200 in if newRot >= 120 then+    sel {tile = Tile.rotate $ tile sel, rotation = Nothing}+    else sel {rotation = Just newRot}+  _ -> sel
+ src/Table.hs view
@@ -0,0 +1,77 @@+module Table where++import qualified Tile+import qualified Hex+import qualified TileGrid as Grid+import qualified TileList+import qualified System.Random as Rand+import qualified Graphics.Gloss.Data.Color as Color+import qualified Graphics.Gloss.Data.Picture as Pict++data Table = Table {tileGrid :: Grid.TileGrid, tileList :: TileList.TileList, randGen :: Rand.StdGen} deriving Show++empty :: Rand.StdGen -> Table+empty gen = Table {tileGrid = Grid.empty 0, tileList = TileList.empty, randGen = gen}++-- displacements; NOTE: Table keeps track of the grid and list displacement, so both can assume they are centered+gridX, listX :: Float+gridX = -120+listX = 230++-- rendering functions+render :: Table -> Pict.Picture+render table = Pict.pictures [+    Pict.translate gridX 0 $ renderGridSpace table,+    Pict.translate listX 0 $ renderListSpace table+  ]++renderGridSpace :: Table -> Pict.Picture+renderGridSpace table = Pict.pictures [+    Pict.color Color.black $ Hex.hexagonSolidPointy 240,+    Grid.render rugColor $ tileGrid table+  ]++renderListSpace :: Table -> Pict.Picture+renderListSpace table = Pict.pictures [+    Pict.color Color.black $ Hex.rectangleBlunt 220 460,+    Pict.color rugColor $ Hex.rectangleBlunt 210 450,+    TileList.render $ tileList table+  ]++rugColor :: Color.Color+rugColor = Color.dark $ Color.dark Color.chartreuse++-- manipulation functions+newGame :: Int -> Table -> Table+newGame level table = table {tileGrid = grid, tileList = TileList.fromList level lst, randGen = newGen}+  where (grid, lst, newGen) = Grid.newGame (Grid.empty level) $ randGen table++clear :: Table -> Table+clear = empty . randGen++grab :: Pict.Point -> Table -> (Table, Maybe Tile.Tile)+grab (x, y) table = case Grid.grab (x-gridX,y) $ tileGrid table of+  (newGrid, Just sel) -> (table {tileGrid = newGrid}, Just $ Tile.moveBy (gridX, 0) sel)+  _ -> case TileList.grab (x-listX, y) $ tileList table of+    (newList, Just sel) -> (table {tileList = newList}, Just $ Tile.moveBy (listX, 0) sel)+    _ -> (table, Nothing)++putTile :: Tile.Tile -> Pict.Point -> Table -> Table+putTile tile (x,y) table = case Grid.pointToIndex (x-gridX,y) $ tileGrid table of+  Just idx -> putTileInGrid tile idx table+  _ -> putTileInList tile table++putTileInGrid :: Tile.Tile -> Grid.Axial -> Table -> Table+putTileInGrid tile idx table+  | Grid.indexIsEmpty idx $ tileGrid table = table {tileGrid = Grid.putTile tile idx $ tileGrid table}+  | otherwise = putTileInList tile table++putTileInList :: Tile.Tile -> Table -> Table+putTileInList tile table = table {tileList = TileList.putTile (Tile.moveBy (-listX, 0) tile) $ tileList table}++isCompleted :: Table -> Bool+isCompleted = Grid.isCompleted . tileGrid++-- stepping+step :: Float -> Table -> Table+step secs table = table {tileList = TileList.step secs $ tileList table}
+ src/Tile.hs view
@@ -0,0 +1,93 @@+module Tile where++import qualified Hex+import qualified Graphics.Gloss.Data.Color as Color+import qualified Graphics.Gloss.Data.Picture as Pict++data Tile = Tile {hexagon :: Hex.Hexagon, faces :: (Int, Int, Int)} deriving (Show)+data Cardinal = North | NorthEast | SouthEast | South | SouthWest | NorthWest deriving (Eq, Enum, Bounded, Show)++empty :: Float -> Tile+empty size = Tile (Hex.Hexagon (0,0) size) (0,0,0)++-- rendering functions+render :: Tile -> Pict.Picture+render tile = Pict.translate x y $ renderCentered tile+  where (x, y) = Hex.center $ hexagon tile++renderRotated :: Float -> Tile -> Pict.Picture+renderRotated rot tile = Pict.translate x y . Pict.rotate rot $ renderCentered tile+  where (x, y) = Hex.center $ hexagon tile++renderCentered :: Tile -> Pict.Picture+renderCentered tile = Pict.pictures [+    Pict.color Color.white . Hex.renderCentered $ hexagon tile,+    Pict.color Color.black $ renderLines tile,+    Pict.color Color.black $ renderFaces tile+  ]++renderLines :: Tile -> Pict.Picture+renderLines Tile {hexagon = hex} = Pict.pictures lns+  where+    (_: border) = take 4 . Hex.hexagonPath $ Hex.radius hex+    faceLn = Pict.line ((0,0):border)+    lns = zipWith Pict.rotate facesRotations $ replicate 3 faceLn++renderFaces :: Tile -> Pict.Picture+renderFaces Tile {faces = (a,b,c), hexagon = hex} = Pict.pictures fcs+  where+    fcs = zipWith Pict.rotate facesRotations $ map (renderFace (Hex.radius hex)) [a,b,c]++renderFace :: Float -> Int -> Pict.Picture+renderFace r n = case n of+  6 -> Pict.pictures [Pict.rotate (-15) far, Pict.rotate 15 far, Pict.rotate (-30) near, Pict.rotate 30 near, renderFace r 2]+  5 -> Pict.pictures [Pict.rotate (-30) near, Pict.rotate 30 near, renderFace r 3]+  4 -> Pict.pictures [near, renderFace r 3]+  3 -> Pict.pictures [far, renderFace r 2]+  2 -> Pict.pictures [Pict.rotate (-40) far, Pict.rotate 40 far]+  1 -> far+  _ -> Pict.Blank+  where+    c = Pict.circleSolid (r/10)+    h = Hex.heightFromRadius r+    far = Pict.translate (r/3) (h/3) c+    near = Pict.translate (r/6) (h/6) c++-- manupulation functions+rotate :: Tile -> Tile+rotate tile = tile {faces = (c,a,b)}+  where (a,b,c) = faces tile++moveTo :: Pict.Point -> Tile -> Tile+moveTo point tile = tile {hexagon = Hex.moveTo point $ hexagon tile}++moveBy :: Pict.Point -> Tile -> Tile+moveBy point tile = tile {hexagon = Hex.moveBy point $ hexagon tile}++sideValue :: Cardinal -> Tile -> Int+sideValue car Tile {faces = (a,b,c)} = case car of+   North -> a+   NorthEast -> a+   SouthEast -> b+   South -> b+   SouthWest -> c+   NorthWest -> c++opposedCardinal :: Cardinal -> Cardinal+opposedCardinal car = case car of+  North -> South+  NorthEast -> SouthWest+  SouthEast -> NorthWest+  South -> North+  SouthWest -> NorthEast+  NorthWest -> SouthEast++allCardinal :: [Cardinal]+allCardinal = [minBound..maxBound]++-- utility functions+facesRotations :: [Float]+facesRotations = [0, 120, 240]++contains :: Pict.Point -> Tile -> Bool+contains pos = Hex.contains pos . hexagon
+ src/TileGrid.hs view
@@ -0,0 +1,185 @@+module TileGrid where++import qualified Tile+import qualified Hex+import qualified Data.Map.Strict as Map+import Data.List (foldl', sortOn)+import qualified System.Random as Rand+import qualified Graphics.Gloss.Data.Color as Color+import qualified Graphics.Gloss.Data.Picture as Pict++-- implementation based on https://www.redblobgames.com/grids/hexagons/+data TileGrid = TileGrid {tileMap :: TileMap, range :: Int, tileSize :: Float} deriving Show+type TileMap = Map.Map Axial Tile.Tile+-- coordinate systems - chosen offset is odd-q+newtype Axial = Axial (Int, Int) deriving (Eq, Ord, Show)+newtype Offset = Offset (Int, Int) deriving (Eq, Ord, Show)+newtype Cubic = Cubic (Int, Int, Int) deriving (Eq, Ord, Show)++-- creation functions+empty :: Int -> TileGrid+empty rg = TileGrid {tileMap = Map.empty, range = rg, tileSize = rangeToSize rg}++newGame :: TileGrid -> Rand.StdGen -> (TileGrid, [Tile.Tile], Rand.StdGen)+newGame grid gen = (clear grid, lst, lastGen)+  where+    rg = range grid+    idxedTiles = zip (everyIndex rg) . repeat . Tile.empty $ tileSize grid+    (fullMap, middleGen) = foldl' fillTile (Map.fromList idxedTiles, gen) idxedTiles+    (randInts, lastGen) = randomInts (totalIndexNum rg) middleGen+    lst = map rotateAndTake . sortOn fst . zip randInts $ Map.elems fullMap++fillTile :: (TileMap, Rand.StdGen) -> (Axial, Tile.Tile) -> (TileMap, Rand.StdGen)+fillTile (tMap, gen) (idx, tile) = (Map.insert idx (tile {Tile.faces = (a,b,c)}) tMap, newGen)+  where+    (a, genA) = fillFace (neighVal idx Tile.North tMap, neighVal idx Tile.NorthEast tMap) gen+    (b, genB) = fillFace (neighVal idx Tile.SouthEast tMap, neighVal idx Tile.South tMap) genA+    (c, newGen) = fillFace (neighVal idx Tile.SouthWest tMap, neighVal idx Tile.NorthWest tMap) genB++fillFace :: (Maybe Int, Maybe Int) -> Rand.StdGen -> (Int, Rand.StdGen)+fillFace neigs gen = case neigs of+  (Just 0, Just 0) -> newRand+  (Just n, Just k) -> if n /= 0 then (n, gen) else (k, gen)+  (Nothing, Just n) -> if n /= 0 then (n, gen) else newRand+  (Just n, Nothing) -> if n /= 0 then (n, gen) else newRand+  _ -> (0, gen)+  where newRand = Rand.randomR (1,6) gen++randomInts :: Int -> Rand.StdGen -> ([Int], Rand.StdGen)+randomInts 0 gen = ([], gen)+randomInts n gen = (val : follRand, follGen)+  where+    (val, nextGen) = Rand.random gen+    (follRand, follGen) = randomInts (n-1) nextGen++rotateAndTake :: (Int, Tile.Tile) -> Tile.Tile+rotateAndTake (n, tile) = (!! mod n 3) $ iterate Tile.rotate tile++-- rendering functions+render :: Color.Color -> TileGrid -> Pict.Picture+render col grid = case range grid of+  0 -> Pict.color col $ Hex.hexagonSolidPointy 230+  rg -> Pict.pictures . map (renderIndex col grid) $ everyIndex rg++renderIndex :: Color.Color -> TileGrid -> Axial ->  Pict.Picture+renderIndex col grid axi = case Map.lookup axi $ tileMap grid of+  Just tile -> Tile.render tile+  _ -> renderEmpty col axi $ tileSize grid++renderEmpty :: Color.Color -> Axial -> Float -> Pict.Picture+renderEmpty col axi rad = Pict.color col $ Hex.render hex+  where hex = Hex.Hexagon {Hex.center = indexCenter axi rad, Hex.radius = rad-1}++-- manipulation functions+putTile :: Tile.Tile -> Axial -> TileGrid -> TileGrid+putTile tile idx grid = grid {tileMap = Map.insert idx fixedTile $ tileMap grid}+  where fixedTile = Tile.moveTo (indexCenter idx (tileSize grid)) tile++grab :: Pict.Point -> TileGrid -> (TileGrid, Maybe Tile.Tile)+grab point grid = case pointToIndex point grid of+  Just idx -> grabIndex idx grid+  _ -> (grid, Nothing)++grabIndex :: Axial -> TileGrid -> (TileGrid, Maybe Tile.Tile)+grabIndex idx grid = case Map.lookup idx $ tileMap grid of+  Just tile -> (grid {tileMap = Map.delete idx $ tileMap grid}, Just tile)+  _ -> (grid, Nothing)++isFull :: TileGrid -> Bool+isFull TileGrid {tileMap = tMap, range = rg} = totalIndexNum rg == Map.size tMap++isCompleted :: TileGrid -> Bool+isCompleted grid+  | isFull grid = all (matchesNeighs (tileMap grid)) . everyIndex $ range grid+  | otherwise = False++clear :: TileGrid -> TileGrid+clear = empty . range++-- utility functions+rangeToSize :: Int -> Float+rangeToSize n = 418 / (2 * (fn+1) + fn)+  where fn = fromIntegral n++indexIsEmpty :: Axial -> TileGrid -> Bool+indexIsEmpty idx = Map.notMember idx . tileMap++totalIndexNum :: Int -> Int+totalIndexNum range = range * (range + 1) `div` 2 * 6 + 1++everyIndex :: Int -> [Axial]+everyIndex = map cubicToAxial . everyCubicIndex++everyCubicIndex :: Int -> [Cubic]+everyCubicIndex range = [Cubic (x,y,z) |+    x <- [(-range)..range],+    y <- [(max (-range) ((-x)-range))..(min range (range-x))],+    let z = (-x)-y,+    x + y + z == 0+  ]++indexCenter :: Axial -> Float -> Pict.Point+indexCenter axi rad = (rad * fromIntegral cl * 1.5, (off + fromIntegral rw) * (-h))+  where+    Offset (cl, rw) = axialToOffset axi+    h = Hex.heightFromRadius rad+    off = if odd cl then 0.5 else 0++pointToIndex :: Pict.Point -> TileGrid -> Maybe Axial+pointToIndex point grid+  | isValidIndex axi grid = Just axi+  | otherwise = Nothing+  where axi = pointToAxial point $ tileSize grid++pointToAxial :: Pict.Point -> Float -> Axial+pointToAxial (x,y) size = Axial (round q, round r)+  where+    q = 2/3 * x / size+    r = ((-1)/3 * x + sqrt 3 / 3 * (-y)) / size++isValidIndex :: Axial -> TileGrid -> Bool+isValidIndex axi grid = cubicDistance (Cubic (0,0,0)) (axialToCubic axi) <= range grid++cubicDistance :: Cubic -> Cubic -> Int+cubicDistance (Cubic (x1,y1,z1)) (Cubic (x2,y2,z2)) = maximum $ map abs [x1-x2, y1-y2, z1-z2]++matchesNeighs :: TileMap -> Axial -> Bool+matchesNeighs tMap idx = case Map.lookup idx tMap of+  Just tile -> all (matchesNeighSide tile idx tMap) Tile.allCardinal+  _ -> False++matchesNeighSide :: Tile.Tile -> Axial -> TileMap -> Tile.Cardinal -> Bool+matchesNeighSide tile idx tMap card = case neighVal idx card tMap of+  Just 0 -> False+  Just n -> Tile.sideValue card tile == n+  Nothing -> True -- always matches an out-of-range tiles++neighVal :: Axial -> Tile.Cardinal -> TileMap -> Maybe Int+neighVal idx card tMap = case neighTile idx card tMap of+  Just tile -> Just $ Tile.sideValue (Tile.opposedCardinal card) tile+  _ -> Nothing++neighTile :: Axial -> Tile.Cardinal -> TileMap -> Maybe Tile.Tile+neighTile idx card = Map.lookup (neighAxial idx card)++neighAxial :: Axial -> Tile.Cardinal -> Axial+neighAxial (Axial (q, r)) card = case card of+  Tile.North -> Axial (q, r-1)+  Tile.NorthEast -> Axial (q+1, r-1)+  Tile.SouthEast -> Axial (q+1, r)+  Tile.South -> Axial (q, r+1)+  Tile.SouthWest -> Axial (q-1, r+1)+  Tile.NorthWest -> Axial (q-1, r)++-- coordinates conversion functions+axialToOffset :: Axial -> Offset+axialToOffset = cubicToOffset . axialToCubic++axialToCubic :: Axial -> Cubic+axialToCubic (Axial (q, r)) = Cubic (q, (-q) - r, r)++cubicToOffset :: Cubic -> Offset+cubicToOffset (Cubic (x, y, z)) = Offset (x, z + (x - (if odd x then 1 else 0)) `div` 2)++cubicToAxial :: Cubic -> Axial+cubicToAxial (Cubic (x, _, z)) = Axial (x, z)
+ src/TileList.hs view
@@ -0,0 +1,80 @@+module TileList where++import qualified Tile+import qualified Hex+import qualified Graphics.Gloss.Data.Picture as Pict+import qualified Graphics.Gloss.Data.Color as Color++-- a stack of tiles and maybe their destination (if they need to move)+data TileList = TileList {tiles :: [Tile.Tile], destinations :: [Maybe Pict.Point], level :: Int} deriving Show++-- creation+empty :: TileList+empty = fromList 0 []++fromList :: Int -> [Tile.Tile] -> TileList+fromList lvl lst = reposition $ TileList {tiles = tls, destinations = [], level = lvl}+  where tls = map (Tile.moveTo (0, topPos lvl)) lst++-- rendering+render :: TileList -> Pict.Picture+render tLst = case level tLst of+  0 -> Pict.blank+  lvl -> Pict.pictures . (renderHole lvl :) . map Tile.render $ take (lvl*2) $ tiles tLst++renderHole :: Int -> Pict.Picture+renderHole lvl = Pict.translate 0 (topPos lvl) . Pict.color Color.black $ Hex.rectangleBlunt 200 (spacing lvl)++--manipulation+reposition :: TileList -> TileList+reposition tLst = tLst {destinations = take (lvl * 2) dests}+  where +    lvl = level tLst+    posMap = (topPos lvl +) . (spacing lvl *) . fromIntegral+    dests = map Just . zip (repeat 0) $ map posMap [1-(lvl*2)..0]++putTile :: Tile.Tile -> TileList -> TileList+putTile tile tLst = reposition $ tLst {tiles = tile : tiles tLst}++grab :: Pict.Point -> TileList -> (TileList, Maybe Tile.Tile)+grab point tLst = (reposition $ tLst {tiles = tls ++ hidden}, sel)+    where+      (visible, hidden) = splitAt (2 * level tLst) $ tiles tLst+      (tls, sel) = grabFromVisible point visible++grabFromVisible :: Pict.Point -> [Tile.Tile] -> ([Tile.Tile], Maybe Tile.Tile)+grabFromVisible _ [] = ([], Nothing)+grabFromVisible pos (tile:tiles)+  | Tile.contains pos tile = (tiles, Just $ Tile.moveTo pos tile)+  | otherwise = let (lst, res) = grabFromVisible pos tiles in (tile:lst, res)++-- stepping+step :: Float -> TileList -> TileList+step secs tLst = tLst {tiles = tls, destinations = dests}+  where+    (visible, hidden) = splitAt (2 * level tLst) $ tiles tLst+    movedTiles = zipWith (stepTile secs) visible $ destinations tLst+    tls = map fst movedTiles ++ hidden+    dests = map snd movedTiles++stepTile :: Float -> Tile.Tile -> Maybe Pict.Point -> (Tile.Tile, Maybe Pict.Point)+stepTile secs tile dest = case dest of+  Just pos -> moveTile secs tile pos+  Nothing -> (tile, dest)++-- utility functions+moveTile :: Float -> Tile.Tile -> Pict.Point -> (Tile.Tile, Maybe Pict.Point)+moveTile secs tile (x,y)+  | distance <= toCover = (Tile.moveTo (x,y) tile, Nothing)+  | otherwise = (Tile.moveBy (xd * toCover, yd * toCover) tile, Just (x,y))+  where+    (xt, yt) = Hex.center $ Tile.hexagon tile -- tile position+    distance = Hex.pointsDistance (xt, yt) (x,y)+    (xd, yd) = ((x-xt) / distance, (y-yt) / distance) -- direction+    toCover = max 10 (secs * 15 * distance) -- distance to cover++topPos :: Int -> Float+topPos lvl = 220 - spacing lvl / 2++spacing :: Int -> Float+spacing lvl = 440 / (2 * fromIntegral lvl)
+ src/Widgets.hs view
@@ -0,0 +1,130 @@+module Widgets where++import qualified Hex+import qualified Table+import qualified Score+import qualified Graphics.Gloss.Data.Picture as Pict+import qualified Graphics.Gloss.Data.Color as Color+import qualified Graphics.Gloss.Data.Point as Point++data Name = Banner | Level | RightArrow | LeftArrow | NewGame | Time | Completed |+  TimeRes | Player | Delete | Submit | LeaderLabel | LeaderSep | LeaderEntry Int |+  InfoLine Int | Info | CloseInfo | CloseGame++-- sizes and positions+shape :: Name -> (Float, Float, Float, Float)+shape name = case name of+  Banner -> (Table.gridX, 100, 350, 80)+  Level -> (Table.gridX, -100, 250, 30)+  RightArrow -> (Table.gridX + 150, -100, 40, 40)+  LeftArrow -> (Table.gridX - 150, -100, 40, 40)+  NewGame -> (Table.gridX, -150, 150, 40)+  Time -> (-270, 220, 160, 30)+  Completed -> (Table.gridX, 120, 200, 30)+  TimeRes -> (Table.gridX, 80, 300, 50)+  Player -> (Table.gridX -30, -100, 90, 30)+  Delete -> (Table.gridX +50, -100, 40, 30)+  Submit -> (Table.gridX, -150, 150, 40)+  LeaderLabel -> (Table.listX, 200, 200, 40)+  LeaderSep -> (Table.listX, 180, 200, 5)+  LeaderEntry n -> (Table.listX, 160 - 40 * fromIntegral n, 230, 45)+  InfoLine n -> (Table.gridX, 40 - 35 * fromIntegral n, 470, 40)+  Info -> (-280, -220, 100, 40)+  CloseInfo -> (Table.gridX, -150, 80, 40)+  CloseGame -> (-280, -220, 100, 40)++-- rendering+renderButton :: Name -> String -> Pict.Picture+renderButton name txt = Pict.translate x y $ Pict.pictures [+    Pict.color buttonColor $ Hex.rectangleBlunt w h,+    Pict.Color Color.white $ Hex.rectangleBluntLine w h,+    Pict.color Color.white $ Hex.hexagonText w h txt+  ]+  where (x, y, w, h) = shape name++renderLabel :: Name -> String -> Pict.Picture+renderLabel name txt = Pict.translate x y $ Pict.pictures [+    Pict.color labelColor $ Pict.rectangleSolid w h,+    Pict.color Color.white $ Hex.hexagonText w h txt+  ]+  where (x, y, w, h) = shape name++renderText :: Name -> String -> Pict.Picture+renderText name = Pict.translate x y . Pict.color Color.white . Hex.hexagonText w h+  where (x, y, w, h) = shape name++renderBanner :: Pict.Picture+renderBanner = renderText Banner "hexmino"++renderGameSelector :: Score.Score -> Pict.Picture+renderGameSelector score = Pict.pictures [+    renderLabel Level $ show lvl,+    renderButton NewGame "new game",+    if Score.isMinLevel lvl then Pict.Blank else renderButton LeftArrow "<",+    if Score.isMaxLevel lvl then Pict.Blank else renderButton RightArrow ">"+  ]+  where lvl = Score.level score++renderTime :: Score.Score -> Pict.Picture+renderTime = renderLabel Time . Score.showTime++renderCompleted :: Score.Score -> Pict.Picture+renderCompleted score = Pict.pictures [+    renderText Completed "completed in",+    renderText TimeRes $ Score.showTime score+  ]++renderNameSelector :: Score.Score -> Pict.Picture+renderNameSelector score = Pict.pictures [+    renderLabel Player txt,+    renderButton Delete "del",+    renderButton Submit "submit"+  ]+  where+    name = Score.player score+    l = length name+    txt = if l < 3 then name ++ ('_' : replicate (2-l) ' ') else take 3 name++renderInfo :: Pict.Picture+renderInfo = Pict.pictures [+    renderButton CloseInfo "back",+    Pict.pictures $ zipWith renderText (map InfoLine [0..]) infoText+  ]++infoText :: [String]+infoText = [+    "drag the tiles on the grid",+    "rotate a tile using space",+    "neighbouring sides must match",+    "",+    "can you solve the expert puzzle?"+  ]++renderInfoButton :: Pict.Picture+renderInfoButton = renderButton Info "info"++renderCloseGame :: Pict.Picture+renderCloseGame = renderButton CloseGame "back"++renderTopTen :: Score.Leaderboard -> Pict.Picture+renderTopTen topTen = Pict.pictures [+    renderText LeaderLabel "leaderboard",+    renderLabel LeaderSep "",+    Pict.pictures . zipWith renderText (map LeaderEntry [0..]) $ map Score.display topTen+  ]++buttonColor :: Color.Color+buttonColor = Color.light Color.blue++labelColor :: Color.Color+labelColor = Color.dark Color.azure++-- click checking+findClicked :: Pict.Point -> [Name] -> Maybe Name+findClicked pos names = case filter (isClicked pos) names of+  [] -> Nothing+  (x:xs) -> Just x++isClicked :: Pict.Point -> Name -> Bool+isClicked pos name = Point.pointInBox pos (x - w/2, y - h/2) (x + w/2, y + h/2)+  where (x, y, w, h) = shape name