Skip to content

Commit

Permalink
feat: explicit memory management (#55), cleaner file loading in examples
Browse files Browse the repository at this point in the history
  • Loading branch information
Anut-py committed Jul 11, 2024
1 parent 10b37d0 commit 8e43da7
Show file tree
Hide file tree
Showing 27 changed files with 509 additions and 438 deletions.
67 changes: 38 additions & 29 deletions examples/basic-audio/src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,37 +1,46 @@
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Paths_h_raylib (getDataFileName)
import Control.Monad (unless, void)
import Raylib.Core (changeDirectory, clearBackground, getApplicationDirectory)
import Raylib.Core (changeDirectory, clearBackground, getApplicationDirectory, initWindow, setTargetFPS, windowShouldClose, closeWindow)
import Raylib.Core.Audio (closeAudioDevice, initAudioDevice, loadMusicStream, playMusicStream, updateMusicStream)
import Raylib.Core.Text (drawText)
import Raylib.Util (drawing, inGHCi, whileWindowOpen0, withWindow)
import Raylib.Util (drawing, inGHCi, whileWindowOpen0, withWindow, managed, WindowResources, raylibApplication)
import Raylib.Util.Colors (lightGray, rayWhite)
import Raylib.Types (Music)

type AppState = (WindowResources, Music)

musicPath :: String
musicPath = (if not inGHCi then "../../../../../../../../../../" else "./") ++ "examples/basic-audio/assets/mini1111.xm"

main :: IO ()
main = do
withWindow
650
400
"raylib [audio] example - basic audio"
60
( \window -> do
initAudioDevice
unless inGHCi (void $ changeDirectory =<< getApplicationDirectory)

music <- loadMusicStream musicPath window
playMusicStream music

whileWindowOpen0
( drawing
( do
clearBackground rayWhite
drawText "You should hear music playing!" 20 20 20 lightGray
)
>> updateMusicStream music
)

closeAudioDevice window
)
musicPath = "examples/basic-audio/assets/mini1111.xm"

startup :: IO AppState
startup = do
window <- initWindow 650 400 "raylib [audio] example - basic audio"
setTargetFPS 60
initAudioDevice

music <- managed window $ loadMusicStream =<< getDataFileName musicPath

playMusicStream music

return (window, music)

mainLoop :: AppState -> IO AppState
mainLoop state@(_, music) = do
drawing $ do
clearBackground rayWhite
drawText "You should hear music playing!" 20 20 20 lightGray
updateMusicStream music
return state

shouldClose :: AppState -> IO Bool
shouldClose _ = windowShouldClose

teardown :: AppState -> IO ()
teardown (window, _) = do
closeAudioDevice (Just window)
closeWindow (Just window)

raylibApplication 'startup 'mainLoop 'shouldClose 'teardown
197 changes: 104 additions & 93 deletions examples/basic-automation-events/src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,13 +1,16 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}

module Main where

import Control.Monad (when)
import Data.Maybe (fromJust, isJust)
import Raylib.Core
( clearBackground,
closeWindow,
getFrameTime,
getMousePosition,
initWindow,
isKeyDown,
isKeyPressed,
isMouseButtonPressed,
Expand All @@ -16,111 +19,119 @@ import Raylib.Core
playAutomationEvent,
setAutomationEventBaseFrame,
setAutomationEventList,
setTargetFPS,
startAutomationEventRecording,
stopAutomationEventRecording,
windowShouldClose,
)
import Raylib.Core.Shapes (drawCircleV, drawRectangle, drawRectangleLines)
import Raylib.Core.Text (drawText, measureText)
import Raylib.Types
( AutomationEvent (AutomationEvent),
AutomationEventList (automationEventList'events),
AutomationEventListRef,
Color (Color),
KeyboardKey (KeyDown, KeyLeft, KeyP, KeyR, KeyRight, KeyUp),
MouseButton (MouseButtonLeft),
pattern Vector2,
)
import Raylib.Util (drawing, whileWindowOpen_, withWindow)
import Raylib.Types.Core (Vector2)
import Raylib.Util (WindowResources, drawing, managed, raylibApplication)
import Raylib.Util.Colors (black, red, white)

main :: IO ()
main =
withWindow
800
600
"raylib [core] example - basic automation events"
60
( \window -> do
rWidth <- measureText "REC" 30
pWidth <- measureText "PLAY" 30

whileWindowOpen_
( \(mState, playback, playing, recording, lRef) ->
drawing
( do
toggleRec <- (&& not playing) <$> isKeyPressed KeyR
let recording' = if toggleRec then not recording else recording
lRef' <-
if toggleRec && recording'
then
( do
l <- newAutomationEventList
Just <$> setAutomationEventList l window
)
else return lRef
when toggleRec $ if recording' then setAutomationEventBaseFrame 60 >> startAutomationEventRecording else stopAutomationEventRecording
when recording' $ drawText "REC" (790 - rWidth) 10 30 red

lEvents <- case lRef' of
Nothing -> return []
Just l -> automationEventList'events <$> peekAutomationEventList l
let playback' =
if toggleRec && not recording'
then Just (lEvents, 0)
else playback
startPlay <- isKeyPressed KeyP
let playing' = isJust playback' && not recording' && (startPlay || playing)

playback'' <-
if playing'
then
( do
let (events, f) = fromJust playback'
let (thisFrame, rest) = span (\(AutomationEvent frame _ _) -> frame == f) events

drawText "PLAY" (790 - pWidth) 10 30 red
mapM_ playAutomationEvent thisFrame

if null events then return Nothing else return $ Just (rest, f + 1)
)
else return playback'
let (playback''', playing'') =
case playback'' of
Nothing -> if null lEvents then (Nothing, False) else (Just (lEvents, 0), False)
v -> (v, playing')

clearBackground white

mousePressed <- isMouseButtonPressed MouseButtonLeft
mousePos <- getMousePosition
frameTime <- getFrameTime
let mState' = if mousePressed then Just (mousePos, 0) else (\(p, t) -> (p, t + frameTime)) <$> mState
let mState'' = mState' >>= (\m@(_, t) -> if t > 2 then Nothing else Just m)

case mState'' of
Nothing -> drawText "Click somewhere or press the arrow keys" 10 10 20 black >> drawText "Press 'R' to start or stop recording, and 'P' to play the recording" 10 40 20 black
Just (p@(Vector2 x y), t) ->
( do
when (t < 1.0) $ drawCircleV p (sin (realToFrac t * pi / 1.0) * 10) red
drawText ("Mouse clicked at (" ++ show x ++ ", " ++ show y ++ ")") 10 (if y < 50 && t < 1.0 then 570 else 10) 20 black
)

uDown <- isKeyDown KeyUp
dDown <- isKeyDown KeyDown
lDown <- isKeyDown KeyLeft
rDown <- isKeyDown KeyRight
let lb = Color 172 204 252 255
let shiftLeft =
case mState'' of
Nothing -> 0
Just (Vector2 x y, t) -> if x > 580 && y > 490 && t < 1.0 then -580 else 0

(if uDown then drawRectangle else drawRectangleLines) (660 + shiftLeft) 500 60 40 lb
(if dDown then drawRectangle else drawRectangleLines) (660 + shiftLeft) 550 60 40 lb
(if lDown then drawRectangle else drawRectangleLines) (590 + shiftLeft) 550 60 40 lb
(if rDown then drawRectangle else drawRectangleLines) (730 + shiftLeft) 550 60 40 lb

return (mState'', playback''', playing'', recording', lRef')
)
)
(Nothing, Nothing, False, False, Nothing)
)
type AppState = (WindowResources, Int, Int, Maybe (Vector2, Float), Maybe ([AutomationEvent], Integer), Bool, Bool, Maybe AutomationEventListRef)

startup :: IO AppState
startup = do
window <- initWindow 800 600 "raylib [core] example - basic automation events"
setTargetFPS 60
rWidth <- measureText "REC" 30
pWidth <- measureText "PLAY" 30
return (window, rWidth, pWidth, Nothing, Nothing, False, False, Nothing)

mainLoop :: AppState -> IO AppState
mainLoop (window, rWidth, pWidth, mState, playback, playing, recording, lRef) = do
drawing
( do
toggleRec <- (&& not playing) <$> isKeyPressed KeyR
let recording' = if toggleRec then not recording else recording
lRef' <-
if toggleRec && recording'
then
( do
l <- newAutomationEventList
Just <$> managed window (setAutomationEventList l)
)
else return lRef
when toggleRec $ if recording' then setAutomationEventBaseFrame 60 >> startAutomationEventRecording else stopAutomationEventRecording
when recording' $ drawText "REC" (790 - rWidth) 10 30 red

lEvents <- case lRef' of
Nothing -> return []
Just l -> automationEventList'events <$> peekAutomationEventList l
let playback' =
if toggleRec && not recording'
then Just (lEvents, 0)
else playback
startPlay <- isKeyPressed KeyP
let playing' = isJust playback' && not recording' && (startPlay || playing)

playback'' <-
if playing'
then
( do
let (events, f) = fromJust playback'
let (thisFrame, rest) = span (\(AutomationEvent frame _ _) -> frame == f) events

drawText "PLAY" (790 - pWidth) 10 30 red
mapM_ playAutomationEvent thisFrame

if null events then return Nothing else return $ Just (rest, f + 1)
)
else return playback'
let (playback''', playing'') =
case playback'' of
Nothing -> if null lEvents then (Nothing, False) else (Just (lEvents, 0), False)
v -> (v, playing')

clearBackground white

mousePressed <- isMouseButtonPressed MouseButtonLeft
mousePos <- getMousePosition
frameTime <- getFrameTime
let mState' = if mousePressed then Just (mousePos, 0) else (\(p, t) -> (p, t + frameTime)) <$> mState
let mState'' = mState' >>= (\m@(_, t) -> if t > 2 then Nothing else Just m)

case mState'' of
Nothing -> drawText "Click somewhere or press the arrow keys" 10 10 20 black >> drawText "Press 'R' to start or stop recording, and 'P' to play the recording" 10 40 20 black
Just (p@(Vector2 x y), t) ->
( do
when (t < 1.0) $ drawCircleV p (sin (realToFrac t * pi / 1.0) * 10) red
drawText ("Mouse clicked at (" ++ show x ++ ", " ++ show y ++ ")") 10 (if y < 50 && t < 1.0 then 570 else 10) 20 black
)

uDown <- isKeyDown KeyUp
dDown <- isKeyDown KeyDown
lDown <- isKeyDown KeyLeft
rDown <- isKeyDown KeyRight
let lb = Color 172 204 252 255
let shiftLeft =
case mState'' of
Nothing -> 0
Just (Vector2 x y, t) -> if x > 580 && y > 490 && t < 1.0 then -580 else 0

(if uDown then drawRectangle else drawRectangleLines) (660 + shiftLeft) 500 60 40 lb
(if dDown then drawRectangle else drawRectangleLines) (660 + shiftLeft) 550 60 40 lb
(if lDown then drawRectangle else drawRectangleLines) (590 + shiftLeft) 550 60 40 lb
(if rDown then drawRectangle else drawRectangleLines) (730 + shiftLeft) 550 60 40 lb

return (window, rWidth, pWidth, mState'', playback''', playing'', recording', lRef')
)

shouldClose :: AppState -> IO Bool
shouldClose _ = windowShouldClose

teardown :: AppState -> IO ()
teardown (window, _, _, _, _, _, _, _) = closeWindow (Just window)

raylibApplication 'startup 'mainLoop 'shouldClose 'teardown
14 changes: 7 additions & 7 deletions examples/basic-callbacks/src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,23 +1,23 @@
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Paths_h_raylib (getDataFileName)
import Raylib.Core (clearBackground, initWindow, setTargetFPS, windowShouldClose, closeWindow, setLoadFileTextCallback, loadFileText, getApplicationDirectory)
import Raylib.Core.Text (drawText)
import Raylib.Util (drawing, raylibApplication, WindowResources, inGHCi)
import Raylib.Util (drawing, raylibApplication, WindowResources, inGHCi, managed)
import Raylib.Util.Colors (black, rayWhite)

filePath :: String
filePath = (if not inGHCi then "../../../../../../../../../../" else "./") ++ "examples/basic-callbacks/assets/data.txt"
filePath = "examples/basic-callbacks/assets/data.txt"

type AppState = (String, WindowResources)

startup :: IO AppState
startup = do
window <- initWindow 600 450 "raylib [core] example - basic callbacks"
setTargetFPS 60
executableDir <- getApplicationDirectory
_ <- setLoadFileTextCallback (\s -> putStrLn ("opening file: " ++ executableDir ++ s) >> readFile (executableDir ++ s)) window
text <- loadFileText filePath
_ <- managed window $ setLoadFileTextCallback (\s -> putStrLn ("opening file: " ++ s) >> readFile s)
text <- loadFileText =<< getDataFileName filePath
return (text, window)

mainLoop :: AppState -> IO AppState
Expand All @@ -33,6 +33,6 @@ shouldClose :: AppState -> IO Bool
shouldClose _ = windowShouldClose

teardown :: AppState -> IO ()
teardown = closeWindow . snd
teardown = closeWindow . Just . snd

$(raylibApplication 'startup 'mainLoop 'shouldClose 'teardown)
raylibApplication 'startup 'mainLoop 'shouldClose 'teardown
13 changes: 6 additions & 7 deletions examples/basic-images/src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{-# LANGUAGE PatternSynonyms #-}
module Main where

import Paths_h_raylib (getDataFileName)
import Control.Monad (unless, void)
import Raylib.Core
( changeDirectory,
Expand All @@ -17,11 +18,11 @@ import Raylib.Core.Textures
loadTextureFromImage,
)
import Raylib.Types (Rectangle (Rectangle), RenderTexture (renderTexture'texture), pattern Vector2)
import Raylib.Util (drawing, inGHCi, textureMode, whileWindowOpen0, withWindow)
import Raylib.Util (drawing, inGHCi, textureMode, whileWindowOpen0, withWindow, managed)
import Raylib.Util.Colors (black, lightGray, orange, white)

logoPath :: String
logoPath = (if not inGHCi then "../../../../../../../../../../" else "./") ++ "examples/basic-images/assets/raylib-logo.png"
logoPath = "examples/basic-images/assets/raylib-logo.png"

main :: IO ()
main = do
Expand All @@ -31,11 +32,9 @@ main = do
"raylib [textures] example - basic images"
60
( \window -> do
unless inGHCi (void $ changeDirectory =<< getApplicationDirectory)

texture <- genImagePerlinNoise 600 450 20 20 2 >>= (`loadTextureFromImage` window)
logo <- loadImage logoPath >>= (`loadTextureFromImage` window)
rt <- loadRenderTexture 200 200 window
texture <- managed window $ loadTextureFromImage =<< genImagePerlinNoise 600 450 20 20 2
logo <- managed window $ loadTextureFromImage =<< loadImage =<< getDataFileName logoPath
rt <- managed window $ loadRenderTexture 200 200

whileWindowOpen0
( drawing
Expand Down
Loading

0 comments on commit 8e43da7

Please sign in to comment.