diff --git a/Labygen.hs b/Labygen.hs --- a/Labygen.hs +++ b/Labygen.hs @@ -4,6 +4,7 @@ import Data.List import Data.Array import System.Random +import qualified Dijkstra data Block = Block | Free deriving (Show, Eq, Ord) @@ -89,3 +90,17 @@ randomFreePosIO laby = do g <- newStdGen return $ fst $ randomFreePos laby g + +isFree laby p = laby ! p == Free + +dijkstra laby p = Dijkstra.dijkstra laby p bnds neighbors + where bnds = bounds laby + neighbors w p = filter (isFree w) $ adjacent (bounds w) p + +distance laby p1 p2 = + dij ! p2 + where + dij = dijkstra laby p1 + +ways laby p = + filter (isFree laby) $ adjacent (bounds laby) p diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,5 @@ module Main where - - import System.Exit ( exitWith, ExitCode(ExitSuccess) ) import Graphics.UI.GLUT #ifdef USE_FTGL @@ -13,6 +11,7 @@ import Topkata.Topka.Ghost import Topkata.Topka.Topka import Data.Maybe (listToMaybe, maybeToList) +import Data.Array import Labygen import Labygen.Render import ReadImage (readImageWithSize) @@ -50,6 +49,7 @@ camera :: IORef Camera, vmode :: IORef ViewMode, laby :: World Pos3, + dij :: Array Pos3 Int, worldDL :: DisplayList, textures :: Textures, score :: IORef Int @@ -81,7 +81,9 @@ setFontFaceSize font 24 72 #endif score <- newIORef 0 - return $ State { topka = ts, laby = laby, vmode = vm, + return $ State { topka = ts, + laby = laby, dij = dijkstra laby target, + vmode = vm, camera = camera, worldDL = worldDL, ghosts = ghosts, score = score, @@ -90,10 +92,11 @@ , font1 = font #endif } - where origin = Pos3 (0, 0, 0) - target = Pos3 (30, 0, 30) - middle x = fromIntegral x - 0.5 + where middle x = fromIntegral x + 0.5 +origin = Pos3 (0, 0, 0) +target = Pos3 (30, 0, 30) + tex e = e . textures incrScore state amount = @@ -459,17 +462,21 @@ return () isWinPosition ts = ix == 30 && iz == 30 + where (ix, _, iz) = topPos ts + +topPos ts = (ifloor x, ifloor y, ifloor z) where Vector3 x y z = transVec ts ifloor x = fromIntegral (floor x) - ix = ifloor x - iz = ifloor z +topPos3 = Pos3 . topPos animate snds state = do ts <- readIORef (topka state) when (not (topInWall lab ts)) $ do - let ts' = animateTop mstime ts + let ts' = animateTop mstime ts + dist = (dij state) ! topPos3 ts + putStrLn $ show dist if (topInWall lab ts') then do topkaUpd state updateOrientation flipOrientation when (isWinPosition ts) $ do @@ -482,7 +489,7 @@ hitGroundSnd snds ts ts' rand <- randomIO :: IO Int ghosts state $~ \ gs -> - map (animateGhost rand lab) gs + map (\ ghost -> animateGhost rand lab ghost (topPos3 ts)) gs addTimerCallback mstime $ animate snds state postRedisplay Nothing where mstime = 10 diff --git a/PdfLaby.hs b/PdfLaby.hs new file mode 100644 --- /dev/null +++ b/PdfLaby.hs @@ -0,0 +1,28 @@ +module Main (main) where + +import Labygen +import Graphics.Rendering.Cairo +import System.Random +import Data.Array + + +drawBlock p Free = return () +drawBlock (Pos2 (x,y)) Block = do + rectangle (fromIntegral (x-1) * 20.0) (fromIntegral (y-1) * 40.0) 20 40 + fill + +draw laby = do + setSourceRGBA 0.0 0.0 0.0 1.0 + translate 20 40 + rectangle 0 0 (fromIntegral xb * 20.0) (fromIntegral yb * 40.0) + stroke + sequence_ [ drawBlock p b | (p, b) <- assocs laby ] + where (_, Pos2 (xb, yb)) = bounds laby + +main = do + putStrLn "LabyGen" + laby <- labygenIO (Pos2 (1,1), (Pos2 (30,50))) (Pos2 (1,1)) (Pos2 (30, 50)) + withPDFSurface "laby.pdf" 740 2100 $ \ sf -> + renderWith sf $ draw laby + + diff --git a/Topkata/Topka/Base.hs b/Topkata/Topka/Base.hs --- a/Topkata/Topka/Base.hs +++ b/Topkata/Topka/Base.hs @@ -1,6 +1,7 @@ module Topkata.Topka.Base where import Graphics.UI.GLUT +import Labygen data Textures = Textures { texTopkata, texGhost :: Maybe TextureObject @@ -75,3 +76,14 @@ East -> West West -> East + +ifloor x = fromIntegral $ floor x + +dirToNeighbor :: Pos3 -> Pos3 -> Direction +dirToNeighbor (Pos3 (x1, _, z1)) (Pos3 (x2, _, z2)) = + case (x2-x1, z2-z1) of + (1, 0) -> West + (0, -1) -> South + (-1, 0) -> East + (0, 1) -> North + _ -> error "angleTo" diff --git a/Topkata/Topka/Ghost.hs b/Topkata/Topka/Ghost.hs --- a/Topkata/Topka/Ghost.hs +++ b/Topkata/Topka/Ghost.hs @@ -4,6 +4,8 @@ import Topkata.Topka.Base import Vector import Labygen +import Data.Array ( (!) ) +import Data.List -- import Debug.Trace (trace) data GhostState = GhostState { @@ -51,7 +53,9 @@ depthMask $= Enabled blend $= Disabled -animateGhost rand laby ghost = + + +animateGhost rand laby ghost target = let speed = ghostSpeed ghost dir = ghostOrientation ghost angle = angleOfDirection dir @@ -59,6 +63,17 @@ dz = speed * cos angle pos@(Vector3 x y z) = ghostPosition ghost (nx, nz) = (x+dx, z+dz) + isMiddle1 c = c' >= 0.45 && c' <= 0.55 where c'= c - ifloor c + isMiddle2 = isMiddle1 nx && isMiddle1 nz + lpos = Pos3 (floor x, 0, floor z) + flur = ways laby lpos + dij = dijkstra laby target + shorter p1 p2 = compare (dij ! p1) (dij !p2) + dbg l = l --trace (show (zip l (map (\x -> dij !x) l))) l + best = head $ sortBy shorter flur + bestDir = if isMiddle2 + then dirToNeighbor lpos best + else dir (wx, wz) = (nx+0.3*sin angle, nz +0.3 * cos angle) rot = if odd rand then rotCW else rotCCW rangle = angleOfDirection (rot dir) @@ -67,9 +82,9 @@ 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) + else (bestDir, Vector3 nx y nz) newSpeed = if newOrient == dir - then min 0.039 (speed + 0.001) + then min 0.020 (speed + 0.001) else 0.005 ghostPhase' = (ghostPhase ghost + 1) `mod` 51 ghost' = ghost { ghostOrientation = newOrient, diff --git a/topkata.cabal b/topkata.cabal --- a/topkata.cabal +++ b/topkata.cabal @@ -1,5 +1,5 @@ Name: topkata -Version: 0.2.1 +Version: 0.2.2 Synopsis: OpenGL Arcade Game Description: Guide a jumping ball through a maze. License: GPL