Output.hs

module YampaSDL2.Backend.Output
  (outputAction) where

import qualified SDL
import qualified SDL.Primitive as GFX
import SDL.Vect
import Data.Colour.SRGB
import Data.List (sortBy)
import Data.StateVar (($=))
import Control.Monad

import YampaSDL2.AppOutput ( AppOutput(..)
                           , Graphics (..)
                           , Camera (..)
                           , RenderShape (..)
                           , ShapeColour (..)
                           )
import YampaSDL2.Geometry

outputAction :: SDL.Renderer -> Bool -> AppOutput -> IO Bool
outputAction renderer changed ao =
  when changed ( do
    let os =
          sortBy (\r1 r2 -> zIndex r1 `compare` zIndex r2) $ objects (graphics ao)
        c = camera (graphics ao)

    SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound
    texture <-
      SDL.createTexture
        renderer
        SDL.RGB24
        SDL.TextureAccessTarget
        ((fmap round . cSize) c)
    SDL.rendererRenderTarget renderer $= return texture
    SDL.clear renderer
    mapM_ (renderView renderer c) os
    SDL.rendererRenderTarget renderer $= Nothing
    SDL.clear renderer
    SDL.copy renderer texture Nothing Nothing
    SDL.present renderer
    SDL.destroyTexture texture
    )
  >> return (shouldExit ao)

renderView :: SDL.Renderer -> Camera -> RenderShape -> IO ()
renderView renderer cam rs = do
  let cameraPoint = (cPos cam)
      cameraView = (cSize cam)

  case rs of
    Container {containerCentre=centre, children=cs } -> do
      mapM_ (renderView renderer (Camera (cameraPoint - centre) cameraView)) (sortBy (\r1 r2 -> zIndex r1 `compare` zIndex r2) cs)
    RS {shape=s} -> do
      let shapePoint = shapeCentre (shape rs)
          adjustedShape =
            s { shapeCentre =
              (shapePoint - cameraPoint) + cameraView/2
            }
      case adjustedShape of
        Rectangle {shapeCentre = V2 x y, rectSize = V2 w h} -> do
          let (RGB r g b) = toSRGB24 (sColour rs)
          let draw = if sFilled rs then GFX.fillRectangle else GFX.rectangle
          draw renderer
            (round <$> V2 (x - w / 2) (getY cameraView - (y + h / 2)))
            (round <$> V2 (x + w / 2) (getY cameraView - (y - h / 2)))
            (V4 r g b maxBound)
        Circle {shapeCentre = V2 x y, radius=rad} -> do
          let (RGB r g b) = toSRGB24 (sColour rs)
          let draw = if sFilled rs then GFX.fillCircle else GFX.circle
          draw renderer
            (round <$> V2 x y)
            (round rad)
            (V4 r g b maxBound)
        Triangle {shapeCentre=V2 x y, pointA=V2 pax pay, pointB=V2 pbx pby, pointC=V2 pcx pcy} -> do
          let (RGB r g b) = toSRGB24 (sColour rs)
          let draw = if sFilled rs then GFX.fillTriangle else GFX.smoothTriangle
          draw renderer
            (round <$> V2 (x + pax) (getY cameraView - (y + pay)))
            (round <$> V2 (x + pbx) (getY cameraView - (y + pby)))
            (round <$> V2 (x + pcx) (getY cameraView - (y + pcy)))
            (V4 r g b maxBound)
  return ()

sColour :: RenderShape -> Colour Double
sColour rs =
  case colour rs of
    (Filled a) -> a
    (Unfilled a) -> a

sFilled :: RenderShape -> Bool
sFilled rs =
  case colour rs of
    (Filled _) -> True
    (Unfilled _) -> False

getY :: V2 a -> a
getY (V2 _ y) = y