twirl-0.4.0.3: example/Main.hs

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (unless)
import Data.Fixed (mod')
import qualified Data.Text as Text
import Twirl
import Twirl.Graphics

type GameState = (Double, Double, Texture, Bool, Bool, Bool, Triangle)

data Triangle = Triangle (Double, Double) Double

main :: IO ()
main =
  runApp $
    TwirlConfig
      { initialState = initState
      , updateFunction = update
      , drawFunction = draw
      , fps = 60
      }

initState :: TwirlMonad GameState
initState = do
  texture <- loadTexture "sample-blue-100x75.png"
  setWindowSize 800 600
  setWindowTitle "Twirl example"
  pure (200, 200, texture, False, False, False, Triangle (200, 200) 1)

update :: GameState -> InputState -> Double -> TwirlMonad GameState
update (x, y, texture, _, _, _, Triangle (tx, ty) scale) inputs dt = do
  let (tx', ty') = updatePosition inputs False $ updatePosition inputs True (tx, ty)
      scale' = updateScale inputs scale
  pure
    ( (x + 400 * dt) `mod'` 800
    , y
    , texture
    , if isKeyDown inputs KeycodeA then True else False
    , if isControllerButtonDown inputs 0 ControllerButtonStart then True else False
    , isMouseDown inputs ButtonLeft
    , Triangle (tx', ty') scale'
    )

draw :: GameState -> TwirlMonad ()
draw (x, y, texture, invisible, controllerStartDown, mouseDown, Triangle (tx, ty) scale) = do
  setColor 0 0 0 255
  rectangle (round x) (round y) 30 30 Hollow
  printText (Text.pack "Hello!") 100 100
  unless invisible $ printText (Text.pack "Press A to turn me invisible!") 500 100
  unless controllerStartDown $ printText (Text.pack "Press Start to turn me invisible!") 500 120
  unless mouseDown $ printText (Text.pack "Press left mouse to turn me invisible!") 500 140
  drawTexture texture 300 300
  polyLine [(400, 400), (440, 420), (410, 440), (450, 450)]
  polyLine $ map (\(xx, yy) -> ((round $ scale * xx) + round tx, (round $ scale * yy) + round ty)) [(0, 0), (40, 0), (0, 30), (0, 0)]

updatePosition :: InputState -> Bool -> (Double, Double) -> (Double, Double)
updatePosition inputs leftStick (tx, ty) =
  let xValue = controllerAxis inputs 0 (if leftStick then ControllerAxisLeftX else ControllerAxisRightX)
      yValue = controllerAxis inputs 0 (if leftStick then ControllerAxisLeftY else ControllerAxisRightY)
      tx' = if abs xValue > 0.3 then tx + xValue * 4 else tx
      ty' = if abs yValue > 0.3 then ty + yValue * 4 else ty
   in (tx', ty')

updateScale :: InputState -> Double -> Double
updateScale inputs scale =
  scale + (0.1 * (controllerAxis inputs 0 ControllerAxisTriggerLeft)) - (0.1 * (controllerAxis inputs 0 ControllerAxisTriggerRight))