#18 Optimes rendering by caching PNGs

lib/CardRenderer.hs

@@ -0,0 +1,86 @@
+module CardRenderer
+( cardHeight
+, cardWidth
+
+, renderCard
+, renderStack
+, renderStacks
+) where
+
+import CardDeck
+import PNGRenderer
+
+----------------------------- Constants ------------------------------
+
+-- The asset directory
+assetDir :: [Char]
+assetDir = "./lib/assets/"
+
+cardWidth :: Float
+cardWidth = 100
+
+cardHeight :: Float
+cardHeight = 134
+
+-- Map of all (rendered) cards
+cardRenders :: [Picture]
+cardRenders = back:placeHolder:deck
+    where deck        = map (renderCard' . showCard) generateDeck
+          back        = renderPNG $ assetDir ++ "back.png"
+          placeHolder = renderPNG $ assetDir ++ "placeholder.png" 
+
+amountOfValues :: Int
+amountOfValues = length $ init $ enumFrom Ace
+
+----------------------------------------------------------------------
+
+-- Render a card using renderPNG.
+renderCard' :: Card -> Picture
+renderCard' (_,_,Hidden)     = renderPNG $ assetDir ++ "back.png"
+renderCard' (ctype,cvalue,_) = renderPNG $ file_dir ++ file_name
+    where typestring  = cardTypeToString ctype
+          valuestring = cardTypeToChar cvalue
+          file_dir    = assetDir ++ typestring ++ "s/"
+          file_name   = typestring ++ "-" ++ valuestring ++ ".png"
+
+-- Render a card using the cached cards.
+renderCard :: Card -> Picture
+renderCard (_, _, Hidden)     = head cardRenders
+renderCard (cType, cValue, _) = cardRenders !! index
+    where index          = 2 + t * amountOfValues + v
+          t              = fromEnum cType
+          v              = fromEnum cValue
+
+-- Spread cards out, by moving each card a distance x over the x-axis
+-- and y over the y-axis.
+spread :: Float -> Float -> [Picture] -> [Picture]
+spread x y = zipWith shift [0 .. ]
+    where shift index = translate (x * index) (y * index)
+
+-- Render all cards of a stack with a card inset of given value.
+renderStack :: Float -> Stack -> Picture
+renderStack _        []    = cardRenders !! 1
+renderStack cardDist stack = compose spreadOutStack
+    where renderedStack  = map renderCard $ reverse stack
+          spreadOutStack = spread 0 cardDist renderedStack
+
+-- Render all cards of multiple stacks, with a given distance between
+-- all stacks and a different distance between cards.
+renderStacks :: Float -> Float -> [Stack] -> Picture
+renderStacks stackDist cardDist = compose . spreadOutStacks
+    where renderedStacks  = map (renderStack cardDist)
+          spreadOutStacks = spread (stackDist + cardWidth) 0 . renderedStacks
+
+cardTypeToString :: CardType -> [Char]
+cardTypeToString Clubs    = "club"
+cardTypeToString Diamonds = "diamond"
+cardTypeToString Hearts   = "heart"
+cardTypeToString Spades   = "spade"
+cardTypeToString _        = ""
+
+cardTypeToChar :: CardValue -> [Char]
+cardTypeToChar Ace   = "A"
+cardTypeToChar Jack  = "J"
+cardTypeToChar Queen = "Q"
+cardTypeToChar King  = "K"
+cardTypeToChar a     = show $ 1 + fromEnum a

lib/SelectorRenderer.hs

@@ -0,0 +1,39 @@
+module SelectorRenderer
+( renderSelector
+, renderSelected
+) where
+
+import Selector
+import PNGRenderer
+
+----------------------------- Constants ------------------------------
+
+selectorFilePath :: FilePath
+selectorFilePath = "./lib/assets/selector.png"
+
+selectedFilePath :: FilePath
+selectedFilePath = "./lib/assets/selected.png"
+
+selectorRenders :: (Picture, Picture)
+selectorRenders = (
+    renderPNG selectorFilePath, 
+    renderPNG selectedFilePath
+    )
+
+----------------------------------------------------------------------
+
+-- Render the outline of the selector. The offset for every value 1 
+-- in the coordinate must be given.
+renderSelector :: Float -> Float -> Selector -> Picture
+renderSelector a b Selector{ position = (x,y) } = translate fx fy render
+    where fx     = fromIntegral x * a
+          fy     = fromIntegral y * b
+          render = fst selectorRenders
+
+-- Render the selected piece if any.
+renderSelected :: Float -> Float -> Selector -> Picture
+renderSelected a b Selector{ selected = Just (x, y) } = translate fx fy render
+    where fx     = fromIntegral x * a
+          fy     = fromIntegral y * b
+          render = snd selectorRenders
+renderSelected _ _ _                                  = blank