diff --git a/layers-game.cabal b/layers-game.cabal --- a/layers-game.cabal +++ b/layers-game.cabal @@ -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 diff --git a/src/AppData.hs b/src/AppData.hs --- a/src/AppData.hs +++ b/src/AppData.hs @@ -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 = []}] } diff --git a/src/Callback/Common.hs b/src/Callback/Common.hs --- a/src/Callback/Common.hs +++ b/src/Callback/Common.hs @@ -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 diff --git a/src/Callback/Key.hs b/src/Callback/Key.hs --- a/src/Callback/Key.hs +++ b/src/Callback/Key.hs @@ -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 diff --git a/src/Callback/MouseButton.hs b/src/Callback/MouseButton.hs --- a/src/Callback/MouseButton.hs +++ b/src/Callback/MouseButton.hs @@ -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) diff --git a/src/Callback/MouseMove.hs b/src/Callback/MouseMove.hs --- a/src/Callback/MouseMove.hs +++ b/src/Callback/MouseMove.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/States/DefiningAnimation.hs b/src/States/DefiningAnimation.hs --- a/src/States/DefiningAnimation.hs +++ b/src/States/DefiningAnimation.hs @@ -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}) diff --git a/src/States/EditModeRunning.hs b/src/States/EditModeRunning.hs --- a/src/States/EditModeRunning.hs +++ b/src/States/EditModeRunning.hs @@ -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 diff --git a/src/States/GameRunning.hs b/src/States/GameRunning.hs --- a/src/States/GameRunning.hs +++ b/src/States/GameRunning.hs @@ -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 diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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