diff --git a/Labygen.hs b/Labygen.hs --- a/Labygen.hs +++ b/Labygen.hs @@ -4,7 +4,6 @@ import Data.List import Data.Array import System.Random -import Debug.Trace data Block = Block | Free deriving (Show, Eq, Ord) @@ -62,7 +61,6 @@ | otherwise = shuffle g1 (zip adj (repeat (p:adj)) ++ t) (g1, g2) = split g canNotExtend laby slist p = length [ a | a <- borders bounds p, laby ! a == Free, not (a `elem` slist)] > 0 - tr p s a = trace ("p=" ++ show p ++ ", a=" ++show a ++ ", slist=" ++ show s ) a @@ -76,10 +74,9 @@ Left _ -> rep f inWall laby x y z = - {- trace (show p) $ -} not (inRange bnds p) || - laby ! p == Block + not (inRange bnds p) || laby ! p == Block where bnds = bounds laby - p = Pos3 ((truncate x), (truncate y), (truncate z)) + p = Pos3 ((floor x), (floor y), (floor z)) diff --git a/Labygen/Render.hs b/Labygen/Render.hs --- a/Labygen/Render.hs +++ b/Labygen/Render.hs @@ -12,9 +12,9 @@ cubicVertices (ix, iy, iz) = let x, y, z :: GLfloat - x = fromIntegral ix - 1 - y = fromIntegral iy - 1 - z = fromIntegral iz - 1 + x = fromIntegral ix + y = fromIntegral iy + z = fromIntegral iz in listArray (1, 8) [Vector3 x y z, -- 1 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,18 +1,22 @@ module Main where + + import System.Exit ( exitWith, ExitCode(ExitSuccess) ) -import Graphics.UI.GLUT +import Graphics.UI.GLUT +#ifdef USE_FTGL + hiding (Font) +import Graphics.Rendering.FTGL +#endif import Data.IORef ( IORef, newIORef, modifyIORef, readIORef, writeIORef ) import Topkata.Topka.Base import Topkata.Topka.Ghost import Topkata.Topka.Topka ---import Data.Array ((!)) import Data.Maybe (listToMaybe, maybeToList) import Labygen import Labygen.Render import ReadImage (readImageWithSize) import Control.Monad( sequence_, when ) -import Data.List( (!!) ) import qualified Vector as V import System.Random (randomIO) @@ -30,6 +34,7 @@ import System.FilePath ( () ) import Paths_topkata (getDataFileName) + data ViewMode = ExploringMode | EgoMode | FollowMode @@ -40,13 +45,17 @@ } data State = State { - topka :: !(IORef TopkaState), - ghosts :: !(IORef [GhostState]), - camera :: !(IORef Camera), - vmode :: !(IORef ViewMode), + topka :: IORef TopkaState, + ghosts :: IORef [GhostState], + camera :: IORef Camera, + vmode :: IORef ViewMode, laby :: World Pos3, worldDL :: DisplayList, - textures :: Textures + textures :: Textures, + score :: IORef Int +#ifdef USE_FTGL + ,font1 :: Font +#endif } @@ -67,17 +76,29 @@ ghosts <- newIORef [newGhost (middle gx) (middle gz)] worldDL <- compileWorldDL bt laby camera <- newIORef $ mkCamera 0.31 0.3 (-0.11) 0.0 +#ifdef USE_FTGL + font <- createTextureFont "/usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf" + setFontFaceSize font 24 72 +#endif + score <- newIORef 0 return $ State { topka = ts, laby = laby, vmode = vm, camera = camera, worldDL = worldDL, ghosts = ghosts, + score = score, textures = textures +#ifdef USE_FTGL + , font1 = font +#endif } - where origin = Pos3 (1, 1, 1) - target = Pos3 (30, 1, 30) + where origin = Pos3 (0, 0, 0) + target = Pos3 (30, 0, 30) middle x = fromIntegral x - 0.5 tex e = e . textures +incrScore state amount = + score state $~ \ s -> s + amount + topkaUpd state f x = topka state $~ \ ts -> f ts x @@ -97,30 +118,6 @@ (x, y, z, phi) <- fmap topView $ get $ topka state return (x, 3, z-2, 0) -{- - - -togglePrimMode state = do - primMode state $~ \ a -> - case a of - LineStrip -> QuadStrip - QuadStrip -> LineStrip - postRedisplay Nothing -} - -{- -xTopMove = move xTrans -yTopMove = move yTrans -zTopMove = move zTrans -xTopRot = move xRot -yTopRot = move yRot -zTopRot = move zRot -openMouth = move mouth - -xrot = xTopRot -yrot = yTopRot -zrot = zTopRot --} - moveD a b c = move a b c >> postRedisplay Nothing camMove state u = @@ -129,21 +126,12 @@ camTurn state d = camera state $~ \ cam -> - cam { camAngle = camAngle cam + d } - -{- -camMoveX state d = camMove state $ (flip V.xmove) d -camMoveY state d = camMove state $ (flip V.ymove) d -camMoveZ state d = camMove state $ (flip V.zmove) d - -} - + cam { camAngle = camAngle cam + d } move r state inc = do r state $~ (+ inc) get $ r state - - camForward state d = do cam <- get (camera state) let angle = camAngle cam @@ -253,14 +241,6 @@ texImage2D Nothing NoProxy lvl RGBA' size 0 bricksData --- ring = mrect - -mrect = [Vertex3 0.25 0.25 0.0, - Vertex3 0.25 0.75 (0.0 :: GLfloat), - Vertex3 0.75 0.25 0.0, - Vertex3 0.75 0.75 0.0] - - processHits :: Maybe [HitRecord] -> IO () processHits Nothing = putStrLn "selection buffer overflow" processHits (Just hitRecords) = do @@ -296,13 +276,26 @@ _ -> return True +white = Color3 1.0 1.0 (1.0 :: GLfloat) + +printString :: State -> Vertex2 GLfloat -> String -> IO () +printString state pos s = do + color white + rasterPos pos +#ifdef USE_FTGL + renderFont (font1 state) "some string" All +#else + renderString Helvetica18 s +#endif + + display state tops = do (_, Size w h) <- get viewport matrixMode $= Projection loadIdentity - --ortho (-2) (2) (-2) 2 (-2) 2 + lighting $= Enabled hit <- return False -- get (showHit state) frustum (-0.2) 0.5 (-0.2) (0.5) (if hit then 0.45 else 0.5) (if hit then 0.5 else 20) @@ -332,9 +325,25 @@ ghosts <- get (ghosts state) showGhosts ghosts tops + showScore state + + flush swapBuffers +showScore state = do + loadIdentity + matrixMode $= Projection + loadIdentity + ortho (-1) 1 (-1) 1 (-1) 1 + matrixMode $= Modelview 0 + loadIdentity + lighting $= Disabled + color white + rasterPos (Vertex2 0.0 (0.0 :: GLfloat)) + scr <- get (score state) + printString state (Vertex2 (-0.99) (-0.99)) $ "Score: " ++ show scr + reshape :: ReshapeCallback reshape size@(Size w h) = do viewport $= (Position 0 0, size) @@ -400,13 +409,7 @@ SpecialKey KeyUp -> topkaUpd state setNextOrientation North _ -> return () -{- -turnTopkaSafe state ts x = - let ts' = turnTopka ts x in - if topInWall (laby state) ts' - then ts - else ts' --} + keyboard state k snds dev = case k of Char '\27' -> do @@ -432,12 +435,12 @@ topInWall laby ts = - inWall laby (x+1+xd) (y+1) (z+1) + inWall laby (x+xd) y (z+zd) where Vector3 x y z = transVec ts phi = topPhi ts sgn = sign (speed ts) zd = 0.3 * cos phi * sgn - xd = 0.3 * sin phi * sgn + xd = 0.3 * sin phi sign x | x > 0 = 1 @@ -455,7 +458,7 @@ #endif return () -isWinPosition ts = ix == 29 && iz == 29 +isWinPosition ts = ix == 30 && iz == 30 where Vector3 x y z = transVec ts ifloor x = fromIntegral (floor x) @@ -465,7 +468,7 @@ animate snds state = do ts <- readIORef (topka state) - when (not ( topInWall lab ts)) $ do + when (not (topInWall lab ts)) $ do let ts' = animateTop mstime ts if (topInWall lab ts') then do topkaUpd state updateOrientation flipOrientation @@ -473,6 +476,7 @@ #ifdef SOUND play [snds !! 1] #endif + incrScore state 1000 writeIORef (topka state) initialTopkaState else do writeIORef (topka state) ts' hitGroundSnd snds ts ts' @@ -490,7 +494,8 @@ runMain prog name = do putStrLn "Topkata..." #ifdef SOUND - dev <- openDevice $ (Just "'( ( devices '( native null ) ) )") + -- dev <- openDevice $ (Just "'( ( devices '( native null ) ) )") + dev <- openDevice Nothing boing_path <- getDataFileName' "boing_1.wav" juchhu_path <- getDataFileName' "juchhu.wav" putStrLn $ "loading " ++ boing_path diff --git a/Topkata/Topka/Base.hs b/Topkata/Topka/Base.hs --- a/Topkata/Topka/Base.hs +++ b/Topkata/Topka/Base.hs @@ -42,8 +42,8 @@ ringSegment y1 y2 phase = - concat $ [ [v a y1 (r1 a), v a y2 (r2 a)] | - a <- [0.0, 0.05 .. 2*pi+epsilon] ] + concat [ [v a y1 (r1 a), v a y2 (r2 a)] | + a <- [0.0, 0.05 .. 2*pi+epsilon] ] where v a y r = (TexCoord2 0 (0 :: GLfloat), Vertex3 (r * sin a) y (r * cos a)) p = phase / 4.0 pscale1 = - y1 / pi diff --git a/Topkata/Topka/Ghost.hs b/Topkata/Topka/Ghost.hs --- a/Topkata/Topka/Ghost.hs +++ b/Topkata/Topka/Ghost.hs @@ -25,7 +25,7 @@ drawGhost et pm phase = do texture Texture2D $= Enabled textureBinding Texture2D $= et - textureFunction $= Decal + --textureFunction $= Decal mapM_ (\ a -> drawSegment pm $ segment a (a+epsilon)) [0, epsilon .. pi+epsilon] color (Color3 0.0 1.0 (1.0 :: GLfloat)) mapM_ (\ y -> drawSegment pm $ ringSegment (-y) (-y-epsilon) phase) [0, epsilon .. pi+epsilon] @@ -46,7 +46,9 @@ rotate (180*phi/pi-90) (Vector3 0 1 (0 :: GLfloat)) blend $= Enabled blendFunc $= (SrcAlpha, One) + depthMask $= Disabled callList (DisplayList (tops+phase+52)) + depthMask $= Enabled blend $= Disabled animateGhost rand laby ghost = @@ -59,15 +61,21 @@ (nx, nz) = (x+dx, z+dz) (wx, wz) = (nx+0.3*sin angle, nz +0.3 * cos angle) rot = if odd rand then rotCW else rotCCW - (newOrient, newPos) = if inWall laby (wx+1) (y+1) (wz+1) + rangle = angleOfDirection (rot dir) + randomTurn = rand `mod` 25 == 0 && + let (tx, tz) = (x+sin rangle, z + cos rangle) in + not $ inWall laby (tx+1) (y+1) (tz+1) + (newOrient, newPos) = if inWall laby wx y wz || randomTurn then (rot dir, pos) else (dir, Vector3 nx y nz) newSpeed = if newOrient == dir then min 0.039 (speed + 0.001) else 0.005 + ghostPhase' = (ghostPhase ghost + 1) `mod` 51 ghost' = ghost { ghostOrientation = newOrient, ghostSpeed = newSpeed, - ghostPosition = newPos } + ghostPosition = newPos, + ghostPhase = ghostPhase'} in ghost' diff --git a/Topkata/Topka/Topka.hs b/Topkata/Topka/Topka.hs --- a/Topkata/Topka/Topka.hs +++ b/Topkata/Topka/Topka.hs @@ -56,15 +56,6 @@ else ts { topNextOrientation = d, speed = 0.02 } - -{--turnTopka ts delta = - updateRot ts $ \ (Vector3 a phi b) -> - Vector3 a (phi+delta) b -} - - --- turnTopLeft = turnTopkat (-pi/2) --- turnTopRight = turnTopkat (pi/2) - topPhi = angleOfDirection . topOrientation topView :: TopkaState -> (GLdouble, GLdouble, GLdouble, GLdouble) @@ -74,27 +65,14 @@ in (x, y, z, phi) ---updateState upd f ts = - -- modifyIORef ts $ \t -> upd t f - togglePrimMode LineStrip = QuadStrip togglePrimMode QuadStrip = LineStrip --- togglePrimMode_ = updateState updatePrimMode togglePrimMode - --- move = updateState updateTrans - transVec ts = let Vector3 x y z = topTrans ts + Vector3 0 (0.2+0.2*yheight ts) 0 in Vector3 x y z - - - - - - ring = segment 0.0 0.7 drawGaumen d = @@ -124,9 +102,7 @@ scale 0.3 0.3 (0.3 :: GLdouble) rotate (180*phi/pi-90) (Vector3 0 1 0) - --listBase $= tops callList (DisplayList (tops+m)) - -- drawTopkata pm (fromIntegral m / 100.0) genTopkataCalllist textures = do (base@(DisplayList b):_) <- genObjectNames 102 diff --git a/topkata.cabal b/topkata.cabal --- a/topkata.cabal +++ b/topkata.cabal @@ -1,5 +1,5 @@ Name: topkata -Version: 0.2 +Version: 0.2.1 Synopsis: OpenGL Arcade Game Description: Guide a jumping ball through a maze. License: GPL @@ -28,6 +28,10 @@ Description: build also pdflaby Default: False +Flag FTGL + Description: use FTGL + Default: False + Executable topkata Main-is: Main.hs Build-Depends: base, filepath, GLUT, OpenGL, array, random @@ -38,6 +42,9 @@ if flag(sound) Build-Depends: OpenAL, ALUT cpp-options: -DSOUND + if flag(ftgl) + Build-Depends: FTGL + cpp-options: -DUSE_FTGL Executable pdflaby Main-is: PdfLaby.hs