Cuboid2ΒΆ


_images/cuboid2.jpg

Cuboid2 is a re-implementation of the Cuboid game from Pedro Martins, who originally implemented it with Yampa and GLUT. A typical game level exhibits a green and a red shpere and some cubes arranged in a 3D world. You can move the green sphere along the 3 axes, the movement only stops at other cubes, so it is important not to “loose” the green sphere in space. Goal is to reach the red sphere, the target. After finishing with one level, the next level show up until the third, final level is reached. The level data are from the original game. The original implementation is a showcase for FRP with usage of the Yampa library. The implemenation below uses the HGamer3D API in “imperative” style while keeping the game logic purely functional.

You can play with the following keys:

  • left, right, up, down, page up, page down - move the cursor in the cube
  • W, A, S, D - change viewpoint of camera

Let’s now look through some code snippets from this program. The purely functional game logic of this prgogram is quite short, basically there are three levels implemented and the game data just contain those levels. Each level has the cube position and the start end goal position for the green and red sphere. Then there is a short function, which evaluates a given direction.

-- largest dimension
maxDim :: Int
maxDim = 5

-- logical positions, range from 0 to dim - 1
type FieldPos = (Int, Int, Int) 

-- one level of positions, start and end position
data Level = Level {  lDim :: Int,
                      lField :: [FieldPos],
                      lStart :: FieldPos,
                      lGoal :: FieldPos      }  deriving (Show, Eq)

-- all game data, array of levels
type GameData = [Level]

gameData :: GameData   -- static data of all levels
gameData = [
  Level 5 [(2,2,2),(1,1,1),(3,3,3)] (0, 3, 4) (4, 3, 4) ,
  Level 5 [(0,4,4),(0,0,3),(4,1,3)] (0,4,3) (3,1,0),
  Level 5 [(1,3,0),(3,3,0),(1,1,1),(3,1,1),(3,4,2),(0,3,3),(1,2,4),(2,1,4),(3,0,4),(3,3,4),(4,2,4)] (0,3,4) (4,2,3)  
  ]

           
-- function, evaluating a move, moving the cursor in a specific direction, Bool is if success
steps :: FieldPos -> FieldPos -> Level -> ([FieldPos], Bool)
steps start move level =

    let atGoal p = p == (lGoal level)
        blocked p = p `elem` (lField level)
        outOfBounds (a, b, c) = let d = lDim level in a >= d || b >= d || c >= d || a < 0 || b < 0 || c < 0
        next (x, y, z) (x', y', z') = (x+x', y+y', z+z')
        
        oneStep ps start pos
            | atGoal pos = (ps ++ [pos], True)                        -- stopping at goal
            | blocked pos = (ps, False)                               -- stopping at current pos, blocked
            | outOfBounds pos = (ps ++ [pos, start], False)           -- stopping, due to outofbounds, back to start
            | otherwise = oneStep (ps ++ [pos]) start (next pos move) -- successful step do next step
            
    in oneStep [] start (next start move)

Light is a central element to each 3D game and to have the visuals more nicer to this scenes I added three light sources of differnt type.

    light1 <- newE hg3d [ctLight #: Light (SpotLight (Deg 50) 1.0) 1.0 100.0 1.0, ctPosition #: Vec3 (10) (-10) (-10.0)]
    light2 <- newE hg3d [ctLight #: Light PointLight 0.5 1000.0 0.8, ctPosition #: Vec3 0 0 (-50)]
    light3 <- newE hg3d [ctLight #: Light DirectionalLight 1.0 1000.0 1.0, ctOrientation #: (rotU vec3Y 45 .*. rotU vec3X 45)]

And as a final code snippet, lets look at the actual loop, which runs one level of the game which is shown below.

runLevel varKeysUp allS@(sS, eS, ss) level = do

    newFieldA allS level
    let moveSteps pos list = case list of
            (p: ps) -> moveTime sS pos p (msecT 200) >> moveSteps p ps
            [] -> return ()
        resetKeys = writeVar varKeysUp []
        pause = sleepFor (msecT 20)
        getMove = do
            keys <- updateVar' varKeysUp (\ks -> ([], ks))
            if length keys > 0 
                then case getMoveFromKey (head keys) of
                        Just m -> return m
                        Nothing -> pause >> getMove
                else pause >> getMove
        processMove pos m = case steps pos m level of
            ([], False) -> blinkCursor sS >> return (pos, False)
            (steps, False) -> moveSteps pos steps >> return (((head . reverse) steps), False)
            (steps, True) -> moveSteps pos steps >> return (((head . reverse) steps), True)
        loopKey pos = do
            m <- getMove
            (pos', success) <- processMove pos m
            if success then return () else loopKey pos'
    resetKeys
    loopKey (lStart level)