layers-game 0.3.1 → 0.4
raw patch · 11 files changed
+98/−96 lines, 11 filesdep ~GLFW-bdep ~Gamginedep ~OpenGLRaw
Dependency ranges changed: GLFW-b, Gamgine, OpenGLRaw
Files
- layers-game.cabal +5/−4
- src/AppData.hs +14/−11
- src/Callback/Common.hs +1/−1
- src/Callback/Key.hs +18/−12
- src/Callback/MouseButton.hs +5/−7
- src/Callback/MouseMove.hs +3/−6
- src/Main.hs +29/−29
- src/States/DefiningAnimation.hs +2/−2
- src/States/EditModeRunning.hs +8/−8
- src/States/GameRunning.hs +9/−12
- src/Utils.hs +4/−4
layers-game.cabal view
@@ -1,5 +1,5 @@ name: layers-game-version: 0.3.1+version: 0.4 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -59,6 +59,7 @@ extra-source-files: src/Utils.cpp layers.png+ source-repository head type: git location: https://github.com/dan-t/layers@@ -70,11 +71,11 @@ pretty-show >=1.6.7 && <1.7, cmdargs >=0.10.7 && <0.11, data-lens >=2.10.4 && <2.11,- OpenGLRaw >=1.4.0.0 && <1.5,- GLFW-b >=0.1.0.5 && <0.2,+ OpenGLRaw >=1.4.0.0 && <1.6,+ GLFW-b >=1.0 && <1.5, ListZipper >=1.2.0.2 && <1.3, composition >=1.0.1.0 && <1.1,- Gamgine ==0.2.*+ Gamgine ==0.3.* main-is: Main.hs buildable: True cpp-options: -DCABAL
src/AppData.hs view
@@ -30,6 +30,7 @@ IMPORT_LENS_AS_LE data AppData = AppData {+ window :: GLFW.Window, windowSize :: (Int, Int), frustumSize :: (Double, Double), orthoScale :: Double,@@ -41,6 +42,7 @@ stateTree :: SZ.Zipper GD.Data } +LENS(window) LENS(windowSize) LENS(frustumSize) LENS(orthoScale)@@ -51,8 +53,9 @@ LENS(gameData) LENS(stateTree) -newAppData :: GD.Data -> FilePath -> FilePath -> AppMode -> AppData-newAppData gameData levelsLoadedFrom saveLevelsTo appMode = AppData {+newAppData :: GLFW.Window -> GD.Data -> FilePath -> FilePath -> AppMode -> AppData+newAppData win gameData levelsLoadedFrom saveLevelsTo appMode = AppData {+ window = win, windowSize = (0,0), frustumSize = (0,0), orthoScale = DF.orthoScale,@@ -65,24 +68,24 @@ if appMode == EditMode then SS.root EM.mkEditModeRunningState [Branch {state = ME.mkMovingEntityState,- enterWhen = ByMouseWithMod GLFW.MouseButton0 Pressed Ctrl,- leaveWhen = ByMouse GLFW.MouseButton0 Released,+ enterWhen = ByMouseWithMod GLFW.MouseButton'1 Pressed Ctrl,+ leaveWhen = ByMouse GLFW.MouseButton'1 Released, adjacents = []}, Branch {state = RP.mkResizingPlatformState,- enterWhen = ByMouseWithMod GLFW.MouseButton0 Pressed Shift,- leaveWhen = ByMouse GLFW.MouseButton0 Released,+ enterWhen = ByMouseWithMod GLFW.MouseButton'1 Pressed Shift,+ leaveWhen = ByMouse GLFW.MouseButton'1 Released, adjacents = []}, Branch {state = CP.mkCreatingPlatformState,- enterWhen = ByMouse GLFW.MouseButton0 Pressed,- leaveWhen = ByMouse GLFW.MouseButton0 Released,+ enterWhen = ByMouse GLFW.MouseButton'1 Pressed,+ leaveWhen = ByMouse GLFW.MouseButton'1 Released, adjacents = []}, Branch {state = DA.mkDefiningAnimationState,- enterWhen = ByKey (GLFW.CharKey 'U') Pressed,- leaveWhen = ByKey (GLFW.CharKey 'U') Pressed,+ enterWhen = ByKey (GLFW.Key'U) Pressed,+ leaveWhen = ByKey (GLFW.Key'U) Pressed, adjacents = []}] else SS.root IR.mkIntroRunningState [Branch {state = GR.mkGameRunningState,- enterWhen = ByKey (GLFW.CharKey ' ') Pressed,+ enterWhen = ByKey (GLFW.Key'Space) Pressed, leaveWhen = NoTransition, adjacents = []}] }
src/Callback/Common.hs view
@@ -3,4 +3,4 @@ import qualified Data.IORef as R import qualified Utils as LU -mousePosition appRef = R.readIORef appRef >>= LU.mousePosInLevelCoords+mousePosition win appRef = R.readIORef appRef >>= LU.mousePosInLevelCoords win
src/Callback/Key.hs view
@@ -16,26 +16,32 @@ import qualified Utils as U IMPORT_LENS_AS_LE -type Pressed = Bool-type KeyCallback = (GLFW.Key -> Pressed -> IO ()) -newKeyCallback :: AP.AppDataRef -> KeyCallback+newKeyCallback :: AP.AppDataRef -> GLFW.KeyCallback newKeyCallback appDataRef = callback where- callback GLFW.KeyEsc True = quit- callback (GLFW.CharKey 'Q') True = quit+ callback win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = quit win+ callback win GLFW.Key'Q _ GLFW.KeyState'Pressed _ = quit win - callback (GLFW.CharKey 'S') True = do+ callback _ GLFW.Key'S _ GLFW.KeyState'Pressed _ = do appMode <- AP.appMode <$> R.readIORef appDataRef when (appMode == AP.EditMode) $ do (gdata, saveTo) <- (AP.gameData &&& AP.saveLevelsTo) <$> R.readIORef appDataRef writeFile saveTo (show . TF.toFileData $ gdata) putStrLn $ "layers: Levels data written to file '" ++ saveTo ++ "'" - callback key pressed = do- mpos <- CC.mousePosition appDataRef- mods <- II.pressedModifiers- let keyInfo = KI.KeyInfo key (pressed ? KI.Pressed $ KI.Released) mpos mods- R.modifyIORef appDataRef (AP.handleKeyEvent keyInfo)+ callback win key _ keyState _ = do+ mpos <- CC.mousePosition win appDataRef+ mods <- II.pressedModifiers win+ case keyState of+ GLFW.KeyState'Pressed -> do+ let keyInfo = KI.KeyInfo key II.Pressed mpos mods+ R.modifyIORef appDataRef (AP.handleKeyEvent keyInfo) - quit = GLFW.closeWindow >> GLFW.terminate >> exitSuccess+ GLFW.KeyState'Released -> do+ let keyInfo = KI.KeyInfo key II.Released mpos mods+ R.modifyIORef appDataRef (AP.handleKeyEvent keyInfo)++ _ -> return ()++ quit win = GLFW.destroyWindow win >> GLFW.terminate >> exitSuccess
src/Callback/MouseButton.hs view
@@ -10,14 +10,12 @@ import qualified Callback.Common as CC IMPORT_LENS_AS_LE -type Pressed = Bool-type MouseButtonCallback = (GLFW.MouseButton -> Pressed -> IO ()) -newMouseButtonCallback :: AP.AppDataRef -> MouseButtonCallback+newMouseButtonCallback :: AP.AppDataRef -> GLFW.MouseButtonCallback newMouseButtonCallback appDataRef = callback where- callback button pressed = do- mpos <- CC.mousePosition appDataRef- mods <- II.pressedModifiers- let mouseInfo = MI.MouseInfo button (pressed ? II.Pressed $ II.Released) mpos mods+ callback win button buttonState _ = do+ mpos <- CC.mousePosition win appDataRef+ mods <- II.pressedModifiers win+ let mouseInfo = MI.MouseInfo button (buttonState == GLFW.MouseButtonState'Pressed ? II.Pressed $ II.Released) mpos mods R.modifyIORef appDataRef (AP.handleMouseEvent mouseInfo)
src/Callback/MouseMove.hs view
@@ -6,13 +6,10 @@ import qualified Graphics.UI.GLFW as GLFW import qualified AppData as AP -type X = Int-type Y = Int-type MouseMoveCallback = (X -> Y -> IO ()) -newMouseMoveCallback :: AP.AppDataRef -> MouseMoveCallback+newMouseMoveCallback :: AP.AppDataRef -> GLFW.CursorPosCallback newMouseMoveCallback appRef = callback where- callback x y = do- mp <- LU.windowToLevelCoords (x, y) <$> R.readIORef appRef+ callback win x y = do+ mp <- LU.windowToLevelCoords (floor x, floor y) <$> R.readIORef appRef R.modifyIORef appRef (AP.handleMouseMoved mp)
src/Main.hs view
@@ -31,8 +31,6 @@ IMPORT_LENS_AS_LE -updateLoop = EG.mkUpdateLoop ticksPerSecond maxFrameSkip update- io = ST.liftIO @@ -44,25 +42,36 @@ gameData = TGD.toGameData fileData editMode = LA.editMode args ? AP.EditMode $ AP.GameMode - appDataRef <- newIORef $ AP.newAppData gameData (LA.loadLevelsFrom args) (LA.saveLevelsTo args) editMode+ GLFW.init+ GLFW.windowHint $ GLFW.WindowHint'Resizable True+ GLFW.swapInterval 1+ Just win <- GLFW.createWindow winWidth winHeight "" Nothing Nothing+ GLFW.makeContextCurrent (Just win)+ initGL- initGLFW appDataRef editMode GLF.init++ appDataRef <- newIORef $ AP.newAppData win gameData (LA.loadLevelsFrom args) (LA.saveLevelsTo args) editMode+ initCallbacks appDataRef editMode initRessources appDataRef - time <- GLFW.getTime+ Just time <- GLFW.getTime AP.runAppST (gameLoop time) appDataRef return () gameLoop :: Double -> AP.AppST () gameLoop nextFrame = do+ io GLFW.pollEvents (nextFrame', nextFrameFraction) <- updateLoop nextFrame clearGLState render nextFrameFraction- io GLFW.swapBuffers+ win <- GR.gets AP.window+ io $ GLFW.swapBuffers win gameLoop nextFrame'+ where+ updateLoop = EG.mkUpdateLoop ticksPerSecond maxFrameSkip update update :: AP.AppST ()@@ -108,29 +117,24 @@ GL.glLoadIdentity -initGLFW :: AP.AppDataRef -> AP.AppMode -> IO ()-initGLFW appDataRef appMode = do- GLFW.initialize- GLFW.openWindow GLFW.defaultDisplayOptions {- GLFW.displayOptions_width = winWidth,- GLFW.displayOptions_height = winHeight,- GLFW.displayOptions_windowIsResizable = True- }-- GLFW.setWindowBufferSwapInterval 1- GLFW.setWindowSizeCallback resize- GLFW.setWindowCloseCallback quit- GLFW.setKeyCallback $ KC.newKeyCallback appDataRef- GLFW.setMouseButtonCallback $ MC.newMouseButtonCallback appDataRef- GLFW.setMousePositionCallback $ MM.newMouseMoveCallback appDataRef- GLFW.setMouseWheelCallback $ if appMode == AP.EditMode then updateOrthoScale else \_ -> return ()+initCallbacks :: AP.AppDataRef -> AP.AppMode -> IO ()+initCallbacks appDataRef appMode = do+ win <- getL AP.windowL+ GLFW.setWindowSizeCallback win (Just resize)+ GLFW.setWindowCloseCallback win (Just quit)+ GLFW.setKeyCallback win (Just $ KC.newKeyCallback appDataRef)+ GLFW.setMouseButtonCallback win (Just $ MC.newMouseButtonCallback appDataRef)+ GLFW.setCursorPosCallback win (Just $ MM.newMouseMoveCallback appDataRef)+ GLFW.setScrollCallback win (Just $ if appMode == AP.EditMode then updateOrthoScale else \_ _ _ -> return ()) where- resize width height = do+ resize _ width height = do setL AP.windowSizeL (width, height) modify U.updateBoundarySize updateFrustum updateCamera + quit win = GLFW.destroyWindow win >> GLFW.terminate >> exitSuccess+ updateFrustum = do modify (\app -> let (width, height) = AP.windowSize app@@ -147,8 +151,8 @@ GL.glLoadIdentity GL.glOrtho 0 (G.floatToFloat r) 0 (G.floatToFloat t) (-1) 1 - updateOrthoScale mouseWheelPos = do- setL AP.orthoScaleL (DF.orthoScale + fromIntegral mouseWheelPos)+ updateOrthoScale _ _ yoffset = do+ modL AP.orthoScaleL (+ yoffset) modify U.updateBoundarySize updateFrustum updateCamera@@ -169,7 +173,3 @@ initRessources appDataRef = do res <- RR.newRessources modifyIORef appDataRef $ \app -> app {AP.renderRessources = res}---quit :: IO Bool-quit = GLFW.closeWindow >> GLFW.terminate >> exitSuccess
src/States/DefiningAnimation.hs view
@@ -48,7 +48,7 @@ gd' = E.eMap (\e -> id == EI.entityId e ? setPosition e (Left pos) $ e) gd vel = getVelocity e in Just (gd', mkState $ da {entityId = Just id, velocity = vel, mousePos = mp, path = [pos]})- + _ -> Nothing, ST.leave = \gd ->@@ -71,7 +71,7 @@ ST.mouseEvent = \MI.MouseInfo {MI.button = button, MI.status = status, MI.mousePos = mpos} gd -> case (button, status) of- (GLFW.MouseButton0, II.Pressed) -> (gd, mkState $ da {mousePos = mpos, path = path da ++ [mpos]})+ (GLFW.MouseButton'1, II.Pressed) -> (gd, mkState $ da {mousePos = mpos, path = path da ++ [mpos]}) _ -> (gd, mkState da), ST.mouseMoved = \mp gd -> (gd, mkState $ da {mousePos = mp})
src/States/EditModeRunning.hs view
@@ -40,35 +40,35 @@ keyEvent :: KI.KeyInfo -> GD.Data -> GD.Data keyEvent ki@KI.KeyInfo {KI.key = key, KI.status = status, KI.mousePos = mp@(mpx:.mpy:.mpz:.())} gd = case (key, status) of- (GLFW.CharKey 'P', KI.Pressed) ->+ (GLFW.Key'P, KI.Pressed) -> let starId = LV.freeEntityId $ LE.getL GD.currentLevelL gd starPos = V.v3 (mpx - (fst S.starSize * 0.5)) (mpy - (snd S.starSize * 0.5)) 0 in LE.modL (LV.entitiesL . GD.currentLevelL) (S.newStar starId starPos :) gd - (GLFW.CharKey 'E', KI.Pressed) ->+ (GLFW.Key'E, KI.Pressed) -> let eneId = LV.freeEntityId $ LE.getL GD.currentLevelL gd enePos = V.v3 (mpx - (fst EN.enemySize * 0.5)) (mpy - (snd EN.enemySize * 0.5)) 0 in LE.modL (LV.entitiesL . GD.currentLevelL) (EN.newEnemy eneId (Left enePos):) gd - (GLFW.CharKey 'R', KI.Pressed) ->+ (GLFW.Key'R, KI.Pressed) -> case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of Just e -> E.eFilter ((/= EI.entityId e) . EI.entityId) gd _ -> gd - (GLFW.CharKey 'A', KI.Pressed) ->+ (GLFW.Key'A, KI.Pressed) -> GD.addEmptyLevel (shiftPressed ? GD.BeforeCurrent $ GD.AfterCurrent) gd - (GLFW.CharKey 'M', KI.Pressed) ->+ (GLFW.Key'M, KI.Pressed) -> GD.moveCurrentLevel (shiftPressed ? GD.Forward $ GD.Backward) gd - (GLFW.CharKey 'N', KI.Pressed)+ (GLFW.Key'N, KI.Pressed) | shiftPressed -> GD.toPreviousLevel gd | otherwise -> GD.toNextLevel gd - (GLFW.CharKey 'L', KI.Pressed) ->+ (GLFW.Key'L, KI.Pressed) -> LE.modL GD.currentLevelL LR.reload gd - (GLFW.KeyDel, KI.Pressed) ->+ (GLFW.Key'Delete, KI.Pressed) -> GD.removeCurrentLevel gd _ -> GR.keyEvent ki gd
src/States/GameRunning.hs view
@@ -50,32 +50,29 @@ keyEvent :: KI.KeyInfo -> GD.Data -> GD.Data keyEvent ki@KI.KeyInfo {KI.key = key, KI.status = status, KI.mousePos = mp@(mpx:.mpy:.mpz:.())} gd = case (key, status) of- (GLFW.KeyLeft, KI.Pressed) ->+ (GLFW.Key'Left, KI.Pressed) -> E.eMap (PL.accelerate toTheLeft) gd - (GLFW.KeyLeft, KI.Released) ->+ (GLFW.Key'Left, KI.Released) -> E.eMap (PL.accelerate toTheRight) gd - (GLFW.KeyRight, KI.Pressed) ->+ (GLFW.Key'Right, KI.Pressed) -> E.eMap (PL.accelerate toTheRight) gd - (GLFW.KeyRight, KI.Released) ->+ (GLFW.Key'Right, KI.Released) -> E.eMap (PL.accelerate toTheLeft) gd - (GLFW.KeyUp, KI.Pressed) ->- E.eMap PL.jump gd-- (GLFW.KeySpace, KI.Pressed) ->+ (GLFW.Key'Up, KI.Pressed) -> E.eMap PL.jump gd - (GLFW.CharKey ' ', KI.Pressed) ->+ (GLFW.Key'Space, KI.Pressed) -> E.eMap PL.jump gd - (GLFW.KeyTab, KI.Pressed) ->+ (GLFW.Key'Tab, KI.Pressed) -> LE.modL GD.currentLevelL LV.toNextLayer gd _ -> gd- + where toTheLeft = V.v3 (-PL.playerVelocity) 0 0- toTheRight = V.v3 PL.playerVelocity 0 0 + toTheRight = V.v3 PL.playerVelocity 0 0
src/Utils.hs view
@@ -34,10 +34,10 @@ interpolateFrame factor (E.playerPosition player) (E.playerVelocity player) -mousePosInLevelCoords :: AP.AppData -> IO V.Vect-mousePosInLevelCoords appData = do- xy <- GLFW.getMousePosition- return $ windowToLevelCoords xy appData+mousePosInLevelCoords :: GLFW.Window -> AP.AppData -> IO V.Vect+mousePosInLevelCoords win appData = do+ (x, y) <- GLFW.getCursorPos win+ return $ windowToLevelCoords (floor x, floor y) appData windowToLevelCoords :: (Int, Int) -> AP.AppData -> V.Vect