feat: update to latest aztecs packages and refactor

Author: matthunz

.gitattributes

@@ -1,4 +1,6 @@
 * text=auto
 *.hs text eol=lf
+*.txt text eol=lf
 *.jpg binary
 *.png binary
+*.ttf binary

README.md

@@ -15,8 +15,10 @@ Examples can be run with `cabal run {example}`, for instance `cabal run ecs`
 - [`pong`](https://github.com/aztecs-hs/examples/blob/main/src/Pong.hs): Full pong game implementation
 - [`sprite`](https://github.com/aztecs-hs/examples/blob/main/src/Sprite.hs): Sprite rendering
 - [`spritesheet`](https://github.com/aztecs-hs/examples/blob/main/src/Sprite.hs): Animated sprite sheet rendering
+- [`text`](https://github.com/aztecs-hs/examples/blob/main/src/Text.hs): Text rendering with OpenGL
 - [`window`](https://github.com/aztecs-hs/examples/blob/main/src/Window.hs): GLFW window example
 
 ## Assets
 
 - `IDLE.png`: [Samurai](https://xzany.itch.io/samurai-2d-pixel-art) by mattz_21
+- `Montserrat-VariableFont_wght.ttf`: [Montserrat](https://github.com/JulietaUla/Montserrat) by [JulietaUla](https://github.com/JulietaUla)

assets/Montserrat-VariableFont_wght.ttf

@@ -0,0 +1,93 @@
+Copyright 2024 The Montserrat.Git Project Authors (https://github.com/JulietaUla/Montserrat.git)
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+https://openfontlicense.org
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

assets/OFL.txt

@@ -13,7 +13,7 @@ executable 2D
     build-depends:
         base,
         aztecs >=0.17.1 && <0.18,
-        aztecs-gl >=0.2.1 && <0.3,
+        aztecs-gl >=0.3 && <0.4,
         aztecs-glfw >=0.2 && <0.3
 
 executable ecs
@@ -31,7 +31,7 @@ executable sprite
     build-depends:
         base,
         aztecs >=0.17.1 && <0.18,
-        aztecs-gl >=0.2.1 && <0.3,
+        aztecs-gl >=0.3 && <0.4,
         aztecs-glfw >=0.2 && <0.3
 
 executable spritesheet
@@ -41,7 +41,7 @@ executable spritesheet
     build-depends:
         base,
         aztecs >=0.17.1 && <0.18,
-        aztecs-gl >=0.2.1 && <0.3,
+        aztecs-gl >=0.3 && <0.4,
         aztecs-glfw >=0.2 && <0.3,
         mtl,
         time
@@ -69,11 +69,23 @@ executable pong
     build-depends:
         base,
         aztecs >=0.17.1 && <0.18,
-        aztecs-gl >=0.2.1 && <0.3,
+        aztecs-gl >=0.3 && <0.4,
         aztecs-glfw >=0.2 && <0.3,
+        aztecs-gl-text >=0.1 && <0.2,
         mtl,
         time
 
+executable text
+    main-is:          src/Text.hs
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    build-depends:
+        base,
+        aztecs >=0.17.1 && <0.18,
+        aztecs-gl >=0.3 && <0.4,
+        aztecs-glfw >=0.2 && <0.3,
+        aztecs-gl-text >=0.1 && <0.2
+
 executable window
     main-is:          src/Window.hs
     default-language: Haskell2010

aztecs-examples.cabal

@@ -3,7 +3,7 @@
 module Main where
 
 import Aztecs
-import Aztecs.GL
+import Aztecs.GL.D2
 import Aztecs.GLFW
 import Control.Monad.IO.Class
 import System.IO
@@ -61,6 +61,7 @@ main = runAccess_ $ do
         <> bundle (color 1 0 1 1)
         <> bundle (Parent windowEntity)
 
+  -- Run
   runAccessGLFW $ do
     render
     mKeys <- lookup @_ @Keys windowEntity

src/2D.hs

@@ -21,11 +21,11 @@ run = do
 
   -- Spawn observers that react to lifecycle events on the player's Health component
   _ <- spawn . bundle . observer @IO @(OnInsert Health) player $ \e (OnInsert h) ->
-    observe "insert" e h
-  _ <- spawn . bundle . observer @IO @(OnChange Health) player $ \e change ->
-    liftIO . putStrLn $ "change " ++ show e ++ ": old=" ++ show (onChangeOld change) ++ ", new=" ++ show (onChangeNew change)
+    go "insert" e h
+  _ <- spawn . bundle . observer @IO @(OnChange Health) player $ \e (OnChange _ new) ->
+    go "change" e new
   _ <- spawn . bundle . observer @IO @(OnRemove Health) player $ \e (OnRemove h) ->
-    observe "remove" e h
+    go "remove" e h
 
   -- Trigger events by inserting, changing, and removing the Health component
   _ <- insert player . bundle $ Health 150
@@ -34,7 +34,7 @@ run = do
 
   return ()
   where
-    observe s e h = liftIO . putStrLn $ s ++ " " ++ show e ++ ": " ++ show h
+    go s e h = liftIO . putStrLn $ s ++ " " ++ show e ++ ": " ++ show h
 
 main :: IO ()
 main = runAccess_ run

src/Observers.hs

@@ -6,15 +6,17 @@
 module Main where
 
 import Aztecs
-import Aztecs.GL
+import Aztecs.GL.D2
+import Aztecs.GL.Text
 import Aztecs.GLFW
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.State.Strict
 import Data.Time.Clock
-import System.IO
 import Prelude hiding (lookup)
 
+-- Configuration options
+
 windowW, windowH :: Int
 windowW = 800
 windowH = 600
@@ -36,9 +38,10 @@ ballInitSpeedY = 200
 paddleMargin :: Float
 paddleMargin = 40
 
-newtype GameState = GameState {gsLastTime :: UTCTime}
-  deriving (Show)
+-- Current game state
+newtype GameState = GameState {lastTime :: UTCTime}
 
+-- Game monad
 type GameM = StateT GameState IO
 
 -- Paddle component
@@ -58,12 +61,12 @@ instance (Monad m) => Component m Ball
 main :: IO ()
 main = do
   now <- getCurrentTime
-  let initialState = GameState {gsLastTime = now}
-  (_, _) <- runStateT (runAccess_ setupAndRun) initialState
+  let initialState = GameState {lastTime = now}
+  (_, _) <- runStateT (runAccess_ run) initialState
   putStrLn "Game ended!"
 
-setupAndRun :: Access GameM ()
-setupAndRun = do
+run :: Access GameM ()
+run = do
   -- Spawn the window
   windowEntity <-
     spawn $
@@ -106,26 +109,59 @@ setupAndRun = do
         <> bundle (Parent windowEntity)
         <> bundle (Ball ballInitSpeedX ballInitSpeedY)
 
+  -- Spawn font and score labels
+  font <- spawn . bundle $ Font "assets/Montserrat-VariableFont_wght.ttf"
+
+  leftScoreLabelE <-
+    spawn $
+      bundle (Label "0" font defaultLabelStyle {labelFontSize = 48, labelColor = V4 1 1 1 1})
+        <> bundle (transform2d {transformTranslation = V2 (round (centerX - 60)) (round (fromIntegral windowH - 50 :: Float))} :: Transform2D)
+        <> bundle (Parent windowEntity)
+
+  rightScoreLabelE <-
+    spawn $
+      bundle (Label "0" font defaultLabelStyle {labelFontSize = 48, labelColor = V4 1 1 1 1})
+        <> bundle (transform2d {transformTranslation = V2 (round (centerX + 40)) (round (fromIntegral windowH - 50 :: Float))} :: Transform2D)
+        <> bundle (Parent windowEntity)
+
   -- Run the game loop
-  runAccessGLFW $ run windowEntity leftPaddleE rightPaddleE ballE
+  let rs =
+        Loop
+          { window = windowEntity,
+            leftPaddle = leftPaddleE,
+            rightPaddle = rightPaddleE,
+            ball = ballE,
+            leftScoreLabel = leftScoreLabelE,
+            rightScoreLabel = rightScoreLabelE
+          }
+  runAccessGLFW $ loop rs
+
+data Loop = Loop
+  { window :: EntityID,
+    leftPaddle :: EntityID,
+    rightPaddle :: EntityID,
+    ball :: EntityID,
+    leftScoreLabel :: EntityID,
+    rightScoreLabel :: EntityID
+  }
 
-run :: EntityID -> EntityID -> EntityID -> EntityID -> Access GameM Bool
-run windowE leftE rightE ballE = do
+loop :: Loop -> Access GameM Bool
+loop rs = do
   now <- liftIO getCurrentTime
-  lastTime <- lift $ gets gsLastTime
-  let dt = realToFrac (diffUTCTime now lastTime) :: Float
+  lt <- lift $ gets lastTime
+  let dt = realToFrac (diffUTCTime now lt) :: Float
       dt' = min dt 0.1
-  lift . modify' $ \gs -> gs {gsLastTime = now}
+  lift . modify' $ \gs -> gs {lastTime = now}
 
-  mKeys <- lookup @_ @Keys windowE
+  mKeys <- lookup @_ @Keys (window rs)
   case mKeys of
     Just keys -> do
       if keyJustPressed Key'Escape keys
         then return True
         else do
-          updatePaddle leftE keys Key'W Key'S dt'
-          updatePaddle rightE keys Key'Up Key'Down dt'
-          updateBall dt' ballE leftE rightE
+          updatePaddle (leftPaddle rs) keys Key'W Key'S dt'
+          updatePaddle (rightPaddle rs) keys Key'Up Key'Down dt'
+          updateBall dt' rs
           render
           return False
     Nothing -> do
@@ -149,18 +185,21 @@ updatePaddle paddleE keys upKey downKey dt = do
         $ bundle (t {transformTranslation = V2 x (round newY)} :: Transform2D)
     Nothing -> return ()
 
-updateBall :: Float -> EntityID -> EntityID -> EntityID -> Access GameM ()
-updateBall dt ballE leftE rightE = do
+updateBall :: Float -> Loop -> Access GameM ()
+updateBall dt rs = do
+  let ballE = ball rs
+      leftE = leftPaddle rs
+      rightE = rightPaddle rs
   mBallT <- lookup @_ @Transform2D ballE
   mBall <- lookup @_ @Ball ballE
   mLeftT <- lookup @_ @Transform2D leftE
   mRightT <- lookup @_ @Transform2D rightE
 
   case (mBallT, mBall, mLeftT, mRightT) of
-    (Just ballT, Just ball, Just leftT, Just rightT) -> do
+    (Just ballT, Just ball', Just leftT, Just rightT) -> do
       -- Get current velocity from Ball component
-      let velX = ballVelX ball
-          velY = ballVelY ball
+      let velX = ballVelX ball'
+          velY = ballVelY ball'
 
       let V2 bx by = transformTranslation ballT
           V2 _ ly = transformTranslation leftT
@@ -210,24 +249,26 @@ updateBall dt ballE leftE rightE = do
                   then (Nothing, rightPaddleX - paddleW / 2 - ballR, clampedBy, -(abs velX))
                   else
                     if newBx + ballR < 0
-                      then do
-                        (Just (rightE, "Right"), centerX, centerY, ballInitSpeedX)
+                      then (Just (rightE, False), centerX, centerY, ballInitSpeedX)
                       else
                         if newBx - ballR > fromIntegral windowW
-                          then (Just (leftE, "Left"), centerX, centerY, -ballInitSpeedX)
+                          then (Just (leftE, True), centerX, centerY, -ballInitSpeedX)
                           else (Nothing, newBx, clampedBy, velX)
 
       -- Scoring
       case res of
-        Just (e, s) -> do
+        Just (e, isLeft) -> do
           mPaddle <- lookup @_ @Paddle e
           let !score = case mPaddle of
                 Just p -> paddleScore p + 1
                 Nothing -> 1
           insert e . bundle $ Paddle score
-          liftIO $ do
-            putStrLn $ s ++ " scores! Score: " ++ show score
-            hFlush stdout
+          -- Update the appropriate score label
+          let labelE = if isLeft then leftScoreLabel rs else rightScoreLabel rs
+          mLabel <- lookup @_ @Label labelE
+          case mLabel of
+            Just lbl -> insert labelE . bundle $ lbl {labelText = show score}
+            Nothing -> return ()
         Nothing -> return ()
 
       -- Update ball transform and velocity