topkata 0.2 → 0.2.1
raw patch · 7 files changed
+96/−103 lines, 7 filesdep +FTGL
Dependencies added: FTGL
Files
- Labygen.hs +2/−5
- Labygen/Render.hs +3/−3
- Main.hs +70/−65
- Topkata/Topka/Base.hs +2/−2
- Topkata/Topka/Ghost.hs +11/−3
- Topkata/Topka/Topka.hs +0/−24
- topkata.cabal +8/−1
Labygen.hs view
@@ -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))
Labygen/Render.hs view
@@ -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
Main.hs view
@@ -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
Topkata/Topka/Base.hs view
@@ -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
Topkata/Topka/Ghost.hs view
@@ -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'
Topkata/Topka/Topka.hs view
@@ -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
topkata.cabal view
@@ -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