diff --git a/Labygen/Render.hs b/Labygen/Render.hs --- a/Labygen/Render.hs +++ b/Labygen/Render.hs @@ -3,7 +3,8 @@ where import Labygen -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL import Data.Array import Data.Ix import Debug.Trace diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,550 +1,73 @@ -module Main where - -import System.Exit ( exitWith, ExitCode(ExitSuccess) ) -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.Maybe (listToMaybe, maybeToList) -import Data.Array -import Labygen -import Labygen.Render -import ReadImage (readImageWithSize) -import Control.Monad( sequence_, when ) -import qualified Vector as V -import System.Random (randomIO) - - -#ifdef SOUND -import qualified Sound.ALUT.Initialization as ALUT -import Sound.ALUT.Loaders (createBuffer, SoundDataSource(File)) -import Sound.OpenAL (openDevice, closeDevice) -import Sound.OpenAL.AL.Listener -import Sound.OpenAL.AL.Source -import Sound.OpenAL.AL.Errors -import Sound.ALUT (ALfloat) -#endif - -import System.FilePath ( () ) -import Paths_topkata (getDataFileName) - - -data ViewMode = ExploringMode - | EgoMode - | FollowMode - -data Camera = Camera { - camPosition :: Vector3 GLdouble, - camAngle :: GLdouble -} - -data State = State { - topka :: IORef TopkaState, - ghosts :: IORef [GhostState], - camera :: IORef Camera, - vmode :: IORef ViewMode, - laby :: World Pos3, - dij :: Array Pos3 Int, - worldDL :: DisplayList, - textures :: Textures, - score :: IORef Int -#ifdef USE_FTGL - ,font1 :: Font -#endif - } - - -getDataFileName' fn = getDataFileName ("data" fn) - -mkCamera x y z angle = Camera { - camPosition = Vector3 x y z, - camAngle = angle -} - - -mkstate bt textures = do - ts <- newIORef initialTopkaState - vm <- newIORef FollowMode - sh <- newIORef False - laby <- labygenIO (origin, target) origin target - Pos3 (gx, _, gz) <- randomFreePosIO laby - 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, dij = dijkstra laby target, - vmode = vm, - camera = camera, - worldDL = worldDL, ghosts = ghosts, - score = score, - textures = textures -#ifdef USE_FTGL - , font1 = font -#endif - } - where middle x = fromIntegral x + 0.5 - -origin = Pos3 (0, 0, 0) -target = Pos3 (30, 0, 30) - -tex e = e . textures - -incrScore state amount = - score state $~ \ s -> s + amount - -topkaUpd state f x = - topka state $~ \ ts -> - f ts x - -viewData state = do - vm <- get (vmode state) - case vm of - EgoMode -> do - ts <- get (topka state) - return $ topView ts - ExploringMode -> do - cam <- get (camera state) - let Vector3 camX camY camZ = camPosition cam - angle = camAngle cam - return (camX, camY, camZ, angle) - FollowMode -> do - (x, y, z, phi) <- fmap topView $ get $ topka state - return (x, 3, z-2, 0) - -moveD a b c = move a b c >> postRedisplay Nothing - -camMove state u = - camera state $~ \ cam -> - cam { camPosition = u $ camPosition cam } - -camTurn state d = - camera state $~ \ cam -> - 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 - dx = sin angle * (-d) - dz = cos angle * d - camMove state (\ (Vector3 x y z) -> Vector3 (x+dx) y (z+dz)) - return () - - -showHit = putStrLn "HIT!" - - -safeMove move state d = do - move state d - hit <- testCamHit state - if hit then do - showHit - move state (-d) - else return () - postRedisplay Nothing - - - - - - -myInit = do - clearColor $= Color4 0 0 0 0 - polygonMode $= (Fill, Fill) - - shadeModel $= Smooth - - materialSpecular FrontAndBack $= Color4 1 1 1 1 - materialShininess FrontAndBack $= 25 - colorMaterial $= Just (FrontAndBack, Diffuse) - - position (Light 1) $= Vertex4 0 0.5 (-0.5) 1 - position (Light 0) $= Vertex4 1 2 (-8) 0 - - lighting $= Enabled - light (Light 0) $= Enabled - light (Light 1) $= Enabled - depthFunc $= Just Less - - ambient (Light 0) $= Color4 0.2 0.2 0.2 1.0 - diffuse (Light 0) $= Color4 1 1 1 1 - diffuse (Light 1) $= Color4 1 1 1 1 - specular (Light 1) $= Color4 1 1 1 1 - --position (Light 0) $= Vertex4 0 3 2 0 - - lightModelAmbient $= Color4 0.4 0.4 0.4 1 - lightModelLocalViewer $= Enabled - lightModelTwoSide $= Enabled - - -- blend $= Enabled - -- blendFunc $= (SrcAlpha, OneMinusSrcAlpha) - -- hint PolygonSmooth $= Nicest - --polygonSmooth $= Enabled - - -- hint LineSmooth $= Nicest - -- lineSmooth $= Enabled - - normalize $= Enabled - - let brickSize = TextureSize2D 512 256 - brickTex <- fmap listToMaybe $ genObjectNames 1 - - textureBinding Texture2D $= brickTex - - textureWrapMode Texture2D S $= (Mirrored, Repeat) - textureWrapMode Texture2D T $= (Mirrored, Repeat) - textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest) - - sequence_ $ zipWith (mkTex "brick") [0..9] (reverse $ take 10 $ iterate (* 2) 1) - - eyeTex <- loadEyes "eyes" - geyeTex <- loadEyes "geyes" - - let textures = Textures { - texTopkata = eyeTex, - texGhost = geyeTex - } - mkstate brickTex textures - -loadEyes name = do - let eyeSize = TextureSize2D 256 256 - eyeTex <- fmap listToMaybe $ genObjectNames 1 - - textureBinding Texture2D $= eyeTex - - --textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest) - - textureWrapMode Texture2D S $= (Repeated, Clamp) - textureWrapMode Texture2D T $= (Repeated, Clamp) - textureFilter Texture2D $= ((Nearest, Nothing), Nearest) - mkTex name 0 256 - return eyeTex - - -mkTex prefix lvl xsize = do - let fname = prefix ++ show xsize ++ ".rgb" - let ysize = max 1 (xsize `div` 2) - let size = TextureSize2D xsize ysize - --putStrLn fname - path <- getDataFileName' fname - (_, bricksData) <- readImageWithSize path xsize ysize - texImage2D Nothing NoProxy lvl RGBA' size 0 bricksData - - -processHits :: Maybe [HitRecord] -> IO () -processHits Nothing = putStrLn "selection buffer overflow" -processHits (Just hitRecords) = do - putStrLn ("hits = " ++ show (length hitRecords)) - mapM_ (\(HitRecord z1 z2 names) -> do - putStrLn (" number of names for hit = " ++ show (length names)) - putStr (" z1 is " ++ show z1) - putStrLn ("; z2 is " ++ show z2) - putStr " the name is" - sequence_ [ putStr (" " ++ show n) | Name n <- names ] - putChar '\n') - hitRecords - - -testCamHit state = do - frustum (-0.2) 0.5 (-0.2) (0.5) (0.5) (20) - matrixMode $= Projection - loadIdentity - --ortho (-2) (2) (-2) 2 (-2) 2 - frustum (-0.2) 0.5 (-0.2) (0.5) (0.49) (0.5) - --perspective 60 (fromIntegral w/fromIntegral h) 0.5 20 - depthRange $= (0.45, 0.5) - matrixMode $= Modelview 0 - loadIdentity - (x, y, z, phi) <- viewData state - lookAt (Vertex3 x y z) (Vertex3 (x+2*sin phi) (0.5) (z+2*cos phi)) (Vector3 0 1 0) - (_, maybeHitRecords) <- getHitRecords 128 $ do - withName (Name 0) $ preservingMatrix $ callList (worldDL state) - flush - -- processHits maybeHitRecords - case maybeHitRecords of - Just [] -> return False - _ -> 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 - 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) - - --showHit state $= False - --perspective 60 (fromIntegral w/fromIntegral h) 0.5 20 - depthRange $= (0.5, 20) - matrixMode $= Modelview 0 - loadIdentity - - clear [ ColorBuffer, DepthBuffer ] - loadIdentity - - (x, y, z, phi) <- viewData state - --lookAt (Vertex3 x y z) (Vertex3 (x+2*sin phi) (0.5) (z+2*cos phi)) (Vector3 0 1 0) - lookAt (Vertex3 x y z) (Vertex3 (x+1) (0.5) (z+2*cos phi)) (Vector3 0 1 0) -#ifdef SOUND - listenerPosition $= Vertex3 (realToFrac x) (realToFrac y) (realToFrac z) - listenerVelocity $= Vector3 0 0 (0 :: ALfloat) - orientation $= (Vector3 0 0 1, Vector3 0 1 0) -#endif - - preservingMatrix $ callList (worldDL state) - - - ts <- get (topka state) - showTopkata ts tops - 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) - - -keyboardMouse state snds dev k Down _ _ = keyboard state k snds dev -keyboardMouse _ snds dev _ _ _ _ = return () - -myMotionCallback state pos = return () -- putStrLn ("pos=" ++ show pos) - -syncCamWithTopkata state = do - (x, _, z, phi) <- viewData state - camera state $= Camera { - camPosition = Vector3 x 0.1 z, - camAngle = phi } - -switchMode state = do - syncCamWithTopkata state - vmode state $~ \ v -> - case v of - FollowMode -> EgoMode - EgoMode -> ExploringMode - ExploringMode -> FollowMode - - -camKeyboard state k = - case k of --- Char 'f' -> zmove state (-0.1) --- Char 'b' -> zmove state (0.2) --- Char 'r' -> xTopMove state (-0.2) - SpecialKey KeyRight -> safeMove camTurn state (0.2) --- Char 'l' -> xTopMove state (0.2) - SpecialKey KeyLeft -> safeMove camTurn state (-0.2) --- Char 'd' -> yTopMove state (-0.2) - SpecialKey KeyDown -> safeMove camForward state (0.02) --- Char 'u' -> yTopMove state (0.2) - SpecialKey KeyUp -> safeMove camForward state (-0.02) -{- Char 'x' -> xrot state (10) - Char 'X' -> xrot state (-10) - Char 'y' -> yrot state (10) - Char 'Y' -> yrot state (-10) - Char 'z' -> zrot state (10) - Char 'Z' -> zrot state (-10) - Char 'm' -> openMouth state (0.05) - Char 'M' -> openMouth state (-0.05) - Char '1' -> togglePrimMode state - Char ' ' -> yrot state 10 -} - _ -> return () - -topKeyboard state k = - case k of - SpecialKey KeyRight -> topkaUpd state updateOrientation rotCW - SpecialKey KeyLeft -> topkaUpd state updateOrientation rotCCW - SpecialKey KeyDown -> topkaUpd state updateSpeed (0.005-) - SpecialKey KeyUp -> topkaUpd state updateSpeed (0.005+) - _ -> return () - -followKeyboard state k = - case k of - SpecialKey KeyRight -> topkaUpd state setNextOrientation East - SpecialKey KeyLeft -> topkaUpd state setNextOrientation West - SpecialKey KeyDown -> topkaUpd state setNextOrientation South - SpecialKey KeyUp -> topkaUpd state setNextOrientation North - _ -> return () +module Main (main) where +import qualified Graphics.UI.GLFW as GLFW +import qualified Topkata.CommandLineArgs as Args +import Graphics.Rendering.OpenGL ( ($=) ) +import Data.IORef +import Control.Monad (unless) +import System.IO.Unsafe (unsafePerformIO) +import qualified Graphics.Rendering.OpenGL as GL +import Topkata.Render (render, mkRenderInfo, renderInit) +import Topkata.State +import Topkata.Topka.Topka (animateTop) +import Topkata.Actions +import qualified Topkata.Keyboard as Keyboard +import Control.Concurrent(threadDelay) +import Graphics.Rendering.OpenGL as OpenGL -keyboard state k snds dev = - case k of - Char '\27' -> do - putStrLn "clean up" -#ifdef SOUND - deleteObjectNames snds - mapM_ closeDevice $ maybeToList dev -#endif - exitWith ExitSuccess - Char '\t' -> switchMode state - Char 'f' -> fullScreen - _ -> do - vm <- get (vmode state) - case vm of - EgoMode -> topKeyboard state k - FollowMode -> followKeyboard state k - ExploringMode -> camKeyboard state k +--windowMode True = GLFW.Window +--windowMode False = GLFW.FullScreen -keyboardMouse' a c d e f = do - -- putStrLn $ show c - keyboardMouse a c d e f +simpleErrorCallback e s = + putStrLn $ unwords [show e, show s] +initialize actionSlot windowOption = do + GLFW.setErrorCallback $ Just simpleErrorCallback + r <- GLFW.init + + --check $ GLFW.openWindow (GL.Size 800 600) [] (windowMode windowOption) + Just win <- GLFW.createWindow 800 600 "Topkata" Nothing Nothing + GLFW.makeContextCurrent $ Just win + --GLFW.setWindowTitle win "Topkata" + GL.lighting $= GL.Enabled + version <- OpenGL.get (OpenGL.majorMinor OpenGL.glVersion) + putStrLn $ "version: " ++ show version + renderInit + version <- OpenGL.get (OpenGL.majorMinor OpenGL.glVersion) + putStrLn $ "version: " ++ show version + GLFW.setKeyCallback win (Just $ Keyboard.callback actionSlot) + GLFW.swapInterval 1 + return win -topInWall laby ts = - 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 +quitRef = unsafePerformIO $ newIORef False +{-# NOINLINE quitRef #-} -sign x | x > 0 = 1 -sign x | x < 0 = -1 -sign x = 0 - -hitGroundSnd snds ts ts' = do - --putStrLn $ "ts: " ++ show (yspeed ts) ++ ", ts'= " ++ show (yspeed ts') - when (yspeed ts < 0 && yspeed ts' > 0) $ do - putStrLn "boing" -#ifdef SOUND - errors <- get alErrors - mapM_ (putStrLn . show) errors - play [snds !! 0] -#endif - 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) - -topPos3 = Pos3 . topPos - -animate snds state = do - ts <- readIORef (topka state) - when (not (topInWall lab ts)) $ do - 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 -#ifdef SOUND - play [snds !! 1] -#endif - incrScore state 1000 - writeIORef (topka state) initialTopkaState - else do writeIORef (topka state) ts' - hitGroundSnd snds ts ts' - rand <- randomIO :: IO Int - ghosts state $~ \ gs -> - map (\ ghost -> animateGhost rand lab ghost (topPos3 ts)) gs - addTimerCallback mstime $ animate snds state - postRedisplay Nothing - where mstime = 10 - lab = laby state +keyCallback (GLFW.Key'Escape) GLFW.KeyState'Pressed = writeIORef quitRef True +keyCallback _ _ = return () -compileWorldDL brickTex laby = defineNewList Compile $ render brickTex laby -- drawWorld world (1, 1, 1) - -runMain prog name = do - putStrLn "Topkata..." -#ifdef SOUND - -- dev <- openDevice $ (Just "'( ( devices '( native null ) ) )") - dev <- openDevice Nothing - boing_path <- getDataFileName' "boing_1.wav" - juchhu_path <- getDataFileName' "juchhu.wav" - putStrLn $ "loading " ++ boing_path - boing <- createBuffer $ File boing_path - juchhu <- createBuffer $ File juchhu_path -#else - let dev = Nothing -#endif - --putStrLn (show $ world ! (1, 1, 3) ) - getArgsAndInitialize - initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ] - initialWindowSize $= Size 800 600 - initialWindowPosition $= Position 100 100 - createWindow "Topkata" - state <- myInit - tops <- genTopkataCalllist $ textures state -#ifdef SOUND - snds@[boingSound, juchhuSound] <- genObjectNames 2 :: IO [Source] - - pitch boingSound $= 1.0 - pitch juchhuSound $= 1.0 - --gain sndSrc $= 1.0 - --position sndSrc $= Vertex3 0 0 0 - --velocity sndSrc $= Vector3 0 0 0 - buffer boingSound $= Just boing - buffer juchhuSound $= Just juchhu - loopingMode boingSound $= OneShot - loopingMode juchhuSound $= OneShot - deleteObjectNames [boing, juchhu] -#else - let snds = [] -#endif +mainLoop win renderInfo actionSlot state = do + render renderInfo state + GLFW.swapBuffers win + threadDelay 10 + GLFW.pollEvents + r <- performRecordedActions actionSlot $ stTopka state + case r of + Left () -> return () + Right ts -> + let state' = state { stTopka = ts } in + mainLoop win renderInfo actionSlot $ animate state' - displayCallback $= display state tops - keyboardMouseCallback $= Just (keyboardMouse state snds dev) - passiveMotionCallback $= Just (myMotionCallback state) - reshapeCallback $= Just reshape - addTimerCallback 100 $ animate snds state - mainLoop +animate state = + state { stTopka = animateTop 10 (stTopka state) (stLaby state) } -#ifdef SOUND -main = ALUT.withProgNameAndArgs ALUT.runALUT runMain -#else -main = runMain "" [] -#endif +main = do + args <- Args.args + state <- newState + actionSlot <- newSlot + win <- initialize actionSlot $ Args.windowOption args + renderInfo <- mkRenderInfo state + mainLoop win renderInfo actionSlot state + GLFW.terminate diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -3,19 +3,14 @@ all: topkata -topkata: setup - ./setup build +topkata: + cabal build -setup: Setup.lhs topkata.cabal - ghc --make -o $@ $< - rm -f .flags || true - echo $(FLAGS) > .flags - ./setup configure -f $(FLAGS) -install: topkata - ./setup install +install: + cabal install clean: - ./setup clean && rm -f ./setup + cabal clean .PHONY: topkata install clean diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,26 @@ +Topkata 0.2.3 + - missing module Dijkstra added + +Topkata 0.2.2 + - initial position of ghost fixed + - ghost follows the topkata + +Topkata 0.2.1 + + - some bug fixes + - internal cleanup + - score + - new setup flag FTGL (doesn't work on my machine) + +Topkata 0.2 + + - render a dummy ghost as demo + - fix win position + - clean up + +Topkata 0.1 + + - performance tweaks Don Stewart + - Key 'f' -> Fullscreenmode :-) + - restart when target is reached (and shout "Juchhu") + diff --git a/ReadImage.hs b/ReadImage.hs --- a/ReadImage.hs +++ b/ReadImage.hs @@ -18,7 +18,8 @@ import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose ) import System.IO.Error ( mkIOError, eofErrorType ) import Foreign ( Ptr, alloca, mallocBytes, Storable(..) ) -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL -- This is probably overkill, but anyway... newtype Word32BigEndian = Word32BigEndian Word32 @@ -64,7 +65,7 @@ hGetBufFully handle buf numBytes return (Size width height, PixelData RGB UnsignedByte buf) -readImageWithSize :: FilePath -> GLint -> GLint -> IO (Size, PixelData a) +readImageWithSize :: FilePath -> GLsizei -> GLsizei -> IO (Size, PixelData a) readImageWithSize filePath width height = withBinaryFile filePath $ \handle -> do let numBytes = fromIntegral (3 * width * height) diff --git a/Topkata/CommandLineArgs.hs b/Topkata/CommandLineArgs.hs new file mode 100644 --- /dev/null +++ b/Topkata/CommandLineArgs.hs @@ -0,0 +1,16 @@ +module Topkata.CommandLineArgs where + +import System.Console.ParseArgs + +data Option = WindowOption deriving (Show, Ord, Eq) + +argd :: [ Arg Option ] +argd = [ Arg { argIndex = WindowOption, + argName = Just "window", + argAbbr = Just 'w', + argData = Nothing, + argDesc = "start in window mode" } ] + +args = parseArgsIO ArgsComplete argd + +windowOption args = gotArg args WindowOption diff --git a/Topkata/Render.hs b/Topkata/Render.hs new file mode 100644 --- /dev/null +++ b/Topkata/Render.hs @@ -0,0 +1,96 @@ +module Topkata.Render (render, mkRenderInfo, renderInit) where + +import Graphics.Rendering.OpenGL +import Topkata.Textures +import Topkata.State ( State(..) ) +import Topkata.Topka.Topka (topView, genTopkataCallList, + showTopkata) +import qualified Labygen.Render + +data RenderInfo = RenderInfo { + renderInfoLabyDL :: !DisplayList + ,renderInfoTopkata :: !GLuint +} + +hit = False + +whereToLook state = + let (x, y, z, phi) = topView $ stTopka state in + (x, 3, z-2, 0) + +render renderInfo state = do + matrixMode $= Projection + depthRange $= (0.5, 20) + loadIdentity + --hit <- return False -- get (showHit state) + frustum (-0.2) 0.5 (-0.2) (0.5) (0.5) (if hit then 0.5 else 20) + + matrixMode $= Modelview 0 + loadIdentity + + let (x, y, z, phi) = whereToLook state + --lookAt (Vertex3 x y z) (Vertex3 (x+1) (0.5) (z+2*cos phi)) (Vector3 0 1 0) + lookAt (Vertex3 x y z) (Vertex3 (x+2*sin phi) (0.5) (z+2*cos phi)) (Vector3 0 1 0) + clear [ ColorBuffer, DepthBuffer ] + + + preservingMatrix $ callList $ renderInfoLabyDL renderInfo + + let ts = stTopka state + showTopkata ts $ renderInfoTopkata renderInfo + +mkRenderInfo state = do + brickTex <- loadBrickTex + labyDL <- defineNewList Compile $ Labygen.Render.render brickTex laby + topTex <- loadEyes "eyes" + ghostTex <- loadEyes "geyes" + tops <- genTopkataCallList topTex ghostTex + return $ RenderInfo { + renderInfoLabyDL = labyDL + ,renderInfoTopkata = tops + } + where + laby = stLaby state + +renderInit :: IO () +renderInit = do + clearColor $= Color4 0 0 0 0 + polygonMode $= (Fill, Fill) + + shadeModel $= Smooth + + materialSpecular FrontAndBack $= Color4 1 1 1 1 + materialShininess FrontAndBack $= 25 + colorMaterial $= Just (FrontAndBack, Diffuse) + + position (Light 1) $= Vertex4 0 0.5 (-0.5) 1 + position (Light 0) $= Vertex4 1 2 (-8) 0 + + lighting $= Enabled + light (Light 0) $= Enabled + light (Light 1) $= Enabled + depthFunc $= Just Less + + ambient (Light 0) $= Color4 0.2 0.2 0.2 1.0 + diffuse (Light 0) $= Color4 1 1 1 1 + diffuse (Light 1) $= Color4 1 1 1 1 + specular (Light 1) $= Color4 1 1 1 1 + --position (Light 0) $= Vertex4 0 3 2 0 + + lightModelAmbient $= Color4 0.4 0.4 0.4 1 + lightModelLocalViewer $= Enabled + lightModelTwoSide $= Enabled + + -- blend $= Enabled + -- blendFunc $= (SrcAlpha, OneMinusSrcAlpha) + -- hint PolygonSmooth $= Nicest + --polygonSmooth $= Enabled + + -- hint LineSmooth $= Nicest + -- lineSmooth $= Enabled + + normalize $= Enabled + + + + diff --git a/Topkata/State.hs b/Topkata/State.hs new file mode 100644 --- /dev/null +++ b/Topkata/State.hs @@ -0,0 +1,19 @@ +module Topkata.State where + +import Labygen +import Topkata.Topka.Topka + +data State = State { + stLaby :: !(World Pos3) + ,stTopka :: TopkaState +} + +origin = Pos3 (0, 0, 0) +target = Pos3 (30, 0, 30) + +newState = do + laby <- labygenIO (origin, target) origin target + return $ State { + stLaby = laby + , stTopka = initialTopkaState + } diff --git a/Topkata/Textures.hs b/Topkata/Textures.hs new file mode 100644 --- /dev/null +++ b/Topkata/Textures.hs @@ -0,0 +1,47 @@ +module Topkata.Textures (loadBrickTex, loadEyes) where + +import Graphics.Rendering.OpenGL +import Data.Maybe +import Paths_topkata (getDataFileName) +import System.FilePath ( () ) +import ReadImage (readImageWithSize) + +loadBrickTex = do + let brickSize = TextureSize2D 512 256 + brickTex <- fmap listToMaybe $ genObjectNames 1 + + textureBinding Texture2D $= brickTex + + textureWrapMode Texture2D S $= (Mirrored, Repeat) + textureWrapMode Texture2D T $= (Mirrored, Repeat) + textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest) + + sequence_ $ zipWith (mkTex "brick") [0..9] (reverse $ take 10 $ iterate (* 2) 1) + + return brickTex + +getDataFileName' fn = getDataFileName ("data" fn) + +mkTex prefix lvl xsize = do + let fname = prefix ++ show xsize ++ ".rgb" + let ysize = max 1 (xsize `div` 2) + let size = TextureSize2D xsize ysize + path <- getDataFileName' fname + (_, bricksData) <- readImageWithSize path xsize ysize + texImage2D Texture2D NoProxy lvl RGBA' size 0 bricksData + + + +loadEyes name = do + let eyeSize = TextureSize2D 256 256 + eyeTex <- fmap listToMaybe $ genObjectNames 1 + + textureBinding Texture2D $= eyeTex + + --textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest) + + textureWrapMode Texture2D S $= (Repeated, Clamp) + textureWrapMode Texture2D T $= (Repeated, Clamp) + textureFilter Texture2D $= ((Nearest, Nothing), Nearest) + mkTex name 0 256 + return eyeTex diff --git a/Topkata/Topka/Base.hs b/Topkata/Topka/Base.hs --- a/Topkata/Topka/Base.hs +++ b/Topkata/Topka/Base.hs @@ -1,11 +1,8 @@ module Topkata.Topka.Base where -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL import Labygen - -data Textures = Textures { - texTopkata, texGhost :: Maybe TextureObject -} data Direction = North | East| South | West diff --git a/Topkata/Topka/Ghost.hs b/Topkata/Topka/Ghost.hs --- a/Topkata/Topka/Ghost.hs +++ b/Topkata/Topka/Ghost.hs @@ -1,6 +1,7 @@ module Topkata.Topka.Ghost where -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL import Topkata.Topka.Base import Vector import Labygen diff --git a/Topkata/Topka/Topka.hs b/Topkata/Topka/Topka.hs --- a/Topkata/Topka/Topka.hs +++ b/Topkata/Topka/Topka.hs @@ -1,11 +1,13 @@ module Topkata.Topka.Topka where -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL import Vector import Data.IORef import Debug.Trace (trace) import Topkata.Topka.Ghost import Topkata.Topka.Base +import Labygen (inWall) data TopkaState = TopkaState { @@ -104,7 +106,7 @@ callList (DisplayList (tops+m)) -genTopkataCalllist textures = do +genTopkataCallList topTex ghostTex = do (base@(DisplayList b):_) <- genObjectNames 102 mapM_ (\ m -> do defineList (DisplayList (b+m)) Compile $ @@ -113,14 +115,8 @@ drawGhost ghostTex QuadStrip (2 * pi * fromIntegral m / 51.0) ) [0..51] return b - where topTex = texTopkata textures - ghostTex = texGhost textures - - - - -animateTop mstime ts = +animateTop mstime ts laby = let cm = closeMouth ts m = mouth ts ys = yspeed ts @@ -154,4 +150,20 @@ then ts4 { topOrientation = topNextOrientation ts4, topTrans = Vector3 (floor' x + 0.5) y (floor' z + 0.5) } else ts4 - in ts5 + ts6 = if topInWall laby ts5 then + let ts' = updateTrans ts3 $ \ (Vector3 x y z) -> Vector3 (x-xd) y (z-zd) + orient = flipOrientation $ topOrientation ts' + in + ts' { topOrientation = orient, + topNextOrientation = orient } + else ts5 + in ts6 + + +topInWall laby ts = + inWall laby (x+xd) y (z+zd) + where Vector3 x y z = transVec ts + phi = topPhi ts + sgn = signum (speed ts) + zd = 0.3 * cos phi * sgn + xd = 0.3 * sin phi diff --git a/Vector.hs b/Vector.hs --- a/Vector.hs +++ b/Vector.hs @@ -1,6 +1,7 @@ module Vector where -import Graphics.UI.GLUT +--import Graphics.UI.GLFW +import Graphics.Rendering.OpenGL normalize :: Floating a => Vector3 a -> Vector3 a normalize (Vector3 x y z) = @@ -20,7 +21,7 @@ ypart (Vector3 _ y _) = y zpart (Vector3 _ _ z) = z -instance Floating a => Num (Vector3 a) where +instance (Eq a, Floating a) => Num (Vector3 a) where (Vector3 x1 y1 z1) + (Vector3 x2 y2 z2) = Vector3 (x1 + x2) (y1 + y2) (z1 + z2) (Vector3 x1 y1 z1) * (Vector3 x2 y2 z2) = Vector3 (y1 * z2 - z1 * y2) diff --git a/topkata.cabal b/topkata.cabal --- a/topkata.cabal +++ b/topkata.cabal @@ -1,5 +1,5 @@ Name: topkata -Version: 0.2.3 +Version: 0.2.4 Synopsis: OpenGL Arcade Game Description: Guide a jumping ball through a maze. License: GPL @@ -10,7 +10,7 @@ build-type: Simple Cabal-Version: >= 1.2 Homepage: http://home.arcor.de/chr_bauer/topkata.html -Extra-Source-Files: INSTALL THANKS Makefile +Extra-Source-Files: INSTALL THANKS NEWS Makefile Data-Files: data/boing_1.wav data/brick16.rgb data/brick32.rgb data/brick64.rgb @@ -34,8 +34,9 @@ Executable topkata Main-is: Main.hs - Build-Depends: base, filepath, GLUT, OpenGL, array, random + Build-Depends: base >= 4 && < 5, filepath, GLFW-b, OpenGL, array, random, parseargs Other-Modules: Labygen, Labygen.Render, + Topkata.CommandLineArgs, Topkata.Render, Topkata.State, Topkata.Textures, Topkata.Topka.Topka, Topkata.Topka.Ghost, Topkata.Topka.Base Vector, ReadImage, Dijkstra Extensions: CPP