cuboid 0.11 → 0.12
raw patch · 4 files changed
+28/−13 lines, 4 files
Files
- GameLogic.hs +5/−5
- Input.hs +8/−3
- Main.hs +13/−4
- cuboid.cabal +2/−1
GameLogic.hs view
@@ -25,7 +25,7 @@ -- TODO: watch for leak on ws/as/ss/ds returnA -< Game { level = level,- rotX = (fromInteger $ (ws - ss)),+ rotX = realToFrac (ws - ss), playerPos = pos } where calculatePPos (pos, level) = pos ^+^ (p3DtoV3 $ startingPoint level)@@ -35,14 +35,14 @@ vector3Z pos > sizeN || vector3Z pos < 0 -- TODO: Abstract further? testWinLoseCondition (pos, level)- | pos == (p3DtoV3 $ endPoint level) = Event Win- | testBounds pos (size level) = Event Lose- | otherwise = NoEvent+ | norm (pos ^-^ (p3DtoV3 $ endPoint level)) < 0.5 = Event Win+ | testBounds pos (size level) = Event Lose+ | otherwise = NoEvent selectSpeed :: SF (ParsedInput, Vector3 R, Vector3 R, [Point3D]) (Vector3 R) selectSpeed = proc (pi, pos, speed, obss) -> do- let rotX = (fromInteger $ ((ws pi) - (ss pi)) `mod` 36 + 36) `mod` 36+ let rotX = (fromInteger $ (floor $ (ws pi) - (ss pi)) `mod` 36 + 36) `mod` 36 theta = (((rotX - 6) `div` 9) + 1) `mod` 4 -- TODO: Get rid of the undefineds? speedC <- drSwitch (constant zeroVector) -<
Input.hs view
@@ -15,11 +15,16 @@ keyDowns :: SF (Event Input) (Event Input) keyDowns = arr $ filterE ((==Down) . keyState) -countHold :: SF (Event a) Integer+countHold :: SF (Event a) Integer countHold = count >>> hold 0 +keyIntegral :: Double -> SF (Event a) Double+keyIntegral a = let eventToSpeed (Event _) = a+ eventToSpeed NoEvent = 0 + in arr eventToSpeed >>> integral + data ParsedInput = - ParsedInput { ws :: Integer, as :: Integer, ss :: Integer, ds :: Integer,+ ParsedInput { ws :: Double, as :: Double, ss :: Double, ds :: Double, upEvs :: Event Input, downEvs :: Event Input, rightEvs :: Event Input, leftEvs :: Event Input } @@ -36,7 +41,7 @@ rightEvs <- filterKey (SpecialKey KeyRight) -< down leftEvs <- filterKey (SpecialKey KeyLeft) -< down returnA -< ParsedInput ws as ss ds upEvs downEvs rightEvs leftEvs- where countKey c = filterE ((==(Char c)) . key) ^>> countHold+ where countKey c = filterE ((==(Char c)) . key) ^>> keyIntegral 1 filterKey k = arr $ filterE ((==k) . key)
Main.hs view
@@ -14,18 +14,27 @@ main :: IO () main = do newInput <- newIORef NoEvent+ oldTime <- newIORef (0 :: Int) rh <- reactInit (initGL >> return NoEvent) (\_ _ b -> b >> return False) (parseInput >>> calculateState >>> game) displayCallback $= return () keyboardMouseCallback $= Just (\k ks m _ -> writeIORef newInput (Event $ Keyboard k ks m))- idleCallback $= Just (idle newInput rh) + idleCallback $= Just (idle newInput oldTime rh)+ oldTime' <- get elapsedTime+ writeIORef oldTime oldTime' mainLoop -- | Reactimation iteration, supplying the input-idle :: IORef (Event Input) -> ReactHandle (Event Input) (IO ()) -> IO ()-idle newInput rh = do+idle :: IORef (Event Input) -> IORef Int -> + ReactHandle (Event Input) (IO ()) -> IO ()+idle newInput oldTime rh = do newInput' <- readIORef newInput- react rh (1, Just newInput')+ newTime' <- get elapsedTime+ oldTime' <- get oldTime+ let dt = let dt' = (fromIntegral $ newTime' - oldTime')/50+ in if dt' < 1 then dt' else 1 + react rh (dt, Just newInput')+ writeIORef oldTime newTime' return ()
cuboid.cabal view
@@ -16,12 +16,13 @@ into a configuration file in the future. Synopsis: 3D Yampa/GLUT Puzzle Game -Version: 0.11+Version: 0.12 License: MIT License-file: LICENSE Copyright: (C) 2010 Pedro Martins Author: Pedro Martins <pedromartins.pt@gmail.com> Maintainer: Pedro Martins <pedromartins.pt@gmail.com>+Bug-Reports: http://github.com/pedromartins/cuboid/issues Stability: experimental Build-Type: Simple Cabal-Version: >= 1.4