{-# 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))