HangmanAscii-0.1.0.1: Shape.hs

module HangmanAscii.Shape 
  ( Pixel(..)
  , shapeHangman
  , shapeHangmanRow
  , shapeWonRow
  ) where


import Data.Bool


data Pixel = Pixel 
  { pSeverity :: Int
  , pRow :: Int 
  , pColumn :: Int 
  , pSymbol :: Char
  }
  deriving (Show)


--       
--       
--     \O/
--      | 
--     / \
--  _________
-- |_________|

shapeWon :: [Pixel]
shapeWon = 
  [ Pixel 0 2 5 'O'
  , Pixel 0 2 6 '/'
  , Pixel 0 3 5 '|'
  , Pixel 0 2 4 '\\'
  , Pixel 0 4 4 '/'
  , Pixel 0 4 6 '\\'

  , Pixel 0 5 1 '_' 
  , Pixel 0 5 2 '_' 
  , Pixel 0 5 3 '_' 
  , Pixel 0 5 4 '_' 
  , Pixel 0 5 5 '_' 
  , Pixel 0 5 6 '_' 
  , Pixel 0 5 7 '_' 
  , Pixel 0 5 8 '_' 
  , Pixel 0 5 9 '_' 

  , Pixel 0 6 0 '|' 
  , Pixel 0 6 1 '_' 
  , Pixel 0 6 2 '_' 
  , Pixel 0 6 3 '_' 
  , Pixel 0 6 4 '_' 
  , Pixel 0 6 5 '_' 
  , Pixel 0 6 6 '_' 
  , Pixel 0 6 7 '_' 
  , Pixel 0 6 8 '_' 
  , Pixel 0 6 9 '_' 
  , Pixel 0 6 10 '|' 
  ]

--   +----+
--   |    |
--   |    O 
--   |   /|\
--   |   / \
--  _|_______
-- |_________|

shapeHangman :: [Pixel]
shapeHangman = 
  [ Pixel  6 0 2 '+'
  , Pixel  7 0 3 '-'
  , Pixel  8 0 4 '-'
  , Pixel  9 0 5 '-'
  , Pixel 10 0 6 '-'
  , Pixel 11 0 7 '+'

  , Pixel  5 1 2 '|'
  , Pixel 12 1 7 '|'

  , Pixel  4 2 2 '|'
  , Pixel 13 2 7 'O'

  , Pixel  3 3 2 '|'
  , Pixel 14 3 6 '/'
  , Pixel 15 3 7 '|'
  , Pixel 16 3 8 '\\'

  , Pixel  2 4 2 '|'
  , Pixel 17 4 6 '/'
  , Pixel 18 4 8 '\\'

  , Pixel  1 5 1 '_' 
  , Pixel  1 5 2 '|' 
  , Pixel  1 5 3 '_' 
  , Pixel  1 5 4 '_' 
  , Pixel  1 5 5 '_' 
  , Pixel  1 5 6 '_' 
  , Pixel  1 5 7 '_' 
  , Pixel  1 5 8 '_' 
  , Pixel  1 5 9 '_' 

  , Pixel  1 6 0 '|' 
  , Pixel  1 6 1 '_' 
  , Pixel  1 6 2 '_' 
  , Pixel  1 6 3 '_' 
  , Pixel  1 6 4 '_' 
  , Pixel  1 6 5 '_' 
  , Pixel  1 6 6 '_' 
  , Pixel  1 6 7 '_' 
  , Pixel  1 6 8 '_' 
  , Pixel  1 6 9 '_' 
  , Pixel  1 6 10 '|' 
  ]

shapeCharAt :: [Pixel] -> Int -> Int -> Int -> Char
shapeCharAt [] _ _ _ = ' '
shapeCharAt (x:xs) v r c  
  | (r == pRow x) && (c == pColumn x) = 
      bool (pSymbol x) ' ' (v < (pSeverity x))
  | otherwise = shapeCharAt xs v r c

shapeColumns :: [Pixel] -> Int
shapeColumns s = maximum $ pColumn <$> s

shapeRows :: [Pixel] -> Int
shapeRows s = maximum $ pRow <$> s

shapePixels :: [Pixel] -> Int -> Int -> Int -> Int -> Int -> String
shapePixels shape v row col maxRow maxCol
  | row > maxRow = ""
  | col == maxCol = c : shapePixels shape v (row + 1) 0 maxRow maxCol
  | otherwise = c: shapePixels shape v row (col + 1) maxRow maxCol
  where c = shapeCharAt shape v row col

shapeRow :: [Pixel] -> Int -> Int -> String
shapeRow s row v = shapePixels s v row 0 row (shapeColumns s)

shapeHangmanRow = shapeRow shapeHangman
shapeWonRow = shapeRow shapeWon

printShape :: Int -> IO ()
printShape v = putStrLn $ shapePixels s v 0 0 (shapeRows s) (shapeColumns s)
  where s = shapeHangman