Posts Tagged ‘Haskell’
Space Cowboy: A Shoot’em up game in Haskell: Part 2
Introduction
A couple months back I wrote about a shoot’em up game that I was planning on making in Haskell. My goal was to make something a little more elaborate than my previous games and also take my understanding of Haskell further. Ultimately, I did not use Haskell and instead decided to use C# for the final product (main reason was productivity). Nonetheless, I felt it was worthwhile to post the work that was done on the prototype and talk a bit about the development process.
To get started, here is a quick demo of the features that were implemented in the prototype, namely, the user’s ability to navigate the ship and fire its weapons using the keyboard.
As others have put it, programming in Haskell is like writing a proof, so in similar vein I’m going to present the core modules of the prototype and then build upon those to present the more complicated ones (which follows more or less the development process). The code that is posted here was authored in Leksah, which replaces a lot of common syntax with “source candy”, so hopefully you will be able to deduce the formal syntax.
Mathematics Module
Since I didn’t have a lot experience in designing a game like this in Haskell, I decided I’d start with the basic mathematical model of the game. I thought about the concepts that were needed to represent bodies in a universe and settled on points, vectors and shapes to represent the ideas I had brewing in my head.
Point
The Point data type represents a single coordinate pair on the Euclidean Plane.
type Coordinate = Float data Point = Point Coordinate Coordinate pointZero :: Point pointZero = Point 0.0 0.0 type Distance = Float pointDistance :: Point → Point → Distance pointDistance (Point x y) (Point u v) = sqrt ((x - u)↑2 + (y - v)↑2)
Vector
The Vector data type serves two purposes: the first is to describe the translation of points along the plane and the second is to describe the direction in which bodies are moving. The usual set of operations on Euclidean Vectors were implemented.
data Vector = Vector Coordinate Coordinate instance Eq Vector where (Vector x y) ≡ (Vector u v) = (x ≡ u) ∧ (y ≡ v) (Vector x y) ≠ (Vector u v) = (x ≠ u) ∨ (y ≠ v) vectorZero :: Vector vectorZero = Vector 0.0 0.0 vectorUp :: Vector vectorUp = Vector 0 1 vectorLeft :: Vector vectorLeft = Vector (-1) 0 vectorDown :: Vector vectorDown = Vector 0 (-1) vectorRight :: Vector vectorRight = Vector 1 0 vectorIdentity :: Vector → Vector vectorIdentity (Vector x y) = Vector x y vectorAdd :: Vector → Vector → Vector vectorAdd (Vector x y) (Vector x' y') = Vector (x + x') (y + y') vectorDotProduct :: Vector → Vector → Float vectorDotProduct (Vector x y) (Vector x' y') = (x * x') + (y * y') vectorScale :: Float → Vector → Vector vectorScale a (Vector x' y') = Vector (a * x') (a * y') vectorMinus :: Vector → Vector → Vector vectorMinus (Vector x y) (Vector x' y') = Vector (x - x') (y - y') vectorMagnitude :: Vector → Float vectorMagnitude (u) = sqrt $ vectorDotProduct u u vectorNormalize :: Vector → Vector vectorNormalize (u) | vectorMagnitude u ≡ 0 = Vector 0 0 | otherwise = vectorScale (1.0 / (vectorMagnitude u)) u pointAdd :: Point → Vector → Point pointAdd (Point x y) (Vector u v) = Point (x + u) (y + v)
Shape
Bodies are represented as simple shapes. In the initial round of design, rectangles and ellipses were considered, but for the purpose of developing a prototype, I settled on circles. The benefit is that determining the minimum distance between two circles is simpler and consequently so is detecting collisions.
data Shape = Circle { center :: Point, radius :: Distance } unitCircle :: Shape unitCircle = Circle { center = pointZero, radius = 1.0 } shapeDistance :: Shape → Shape → Distance shapeDistance (Circle c r) (Circle c' r') = (pointDistance c c') - (r + r') shapeCollide :: Shape → Shape → Bool shapeCollide a b = distance ≤ 0 where distance = shapeDistance a b
Physics Module
Now that I had a mathematical model of the objects that would be considered, it made sense to tackle the physics model of the game. Bodies in the game are treated as simple Rigid Bodies with non-rotational Kinematics.
Movement
To capture the kinematics of the bodies, the Movement data type captures the location, velocity and acceleration of a body. The heart of the physics engine is captured in movementEvolved- it is responsible for updating the location, velocity and acceleration over a slice of time.
type Velocity = Vector type Acceleration = Vector data Movement = Movement { location :: Point, velocity :: Velocity, acceleration :: Acceleration } movementZero :: Movement movementZero = Movement { location = pointZero, velocity = vectorZero, acceleration = vectorZero } type Time = Float movementEvolve :: Movement → Time → Movement movementEvolve (Movement l v a) t = Movement l' v' a' where a' = vectorIdentity a v' = vectorAdd (vectorScale t a) v l' = pointAdd l (vectorAdd (vectorScale (t * t / 2.0) a) (vectorScale t v))
Body
Each physical body in the universe has a mass, shape and movement. The second key component of the physics engine is the process of detecting collisions. bodiesCollide is responsible for taking a collection of bodies and for each one, collecting the bodies that collide with it and then supplying that body and its contacts to a function that determines the outcome of the collision.
type Mass = Float data Body a = Body { shape :: Shape, mass :: Mass, movement :: Movement, description :: a } bodyAddMass :: Body a → Mass → Body a bodyAddMass (Body s m mo d) amount = Body { shape = s, mass = m + amount, movement = mo, description = d } bodiesCollide :: [Body a] → (Body a → [Body a] → [Body a]) → [Body a] bodiesCollide xs f = apply [] xs f apply :: [Body a] → [Body a] → (Body a → [Body a] → [Body a]) → [Body a] apply _ [] _ = [] apply leftList (item:rightList) mapping = processed ⊕ remaining where processed = if null collisions then [item] else mapping item collisions collisions = filter (λx → bodyCollide (item, x)) (leftList ⊕ rightList) remaining = apply (leftList ⊕ [item]) rightList mapping bodyCollide :: (Body a, Body a) → Bool bodyCollide (a, b) = shapeCollide (shape a) (shape b) bodyEvolve :: Body a → Time → Body a bodyEvolve (Body (Circle c r) mass m d) t = Body { shape = Circle (location m') r, mass = mass, movement = m', description = d } where m' = movementEvolve m t
Universe
The game universe spans the plane, contains a collection of bodies and a sense of time. The universe brings together the two main components of the physics engine and exposes a way to remove items from the universe.
data Universe a = Universe { bodies :: [Body a], time :: Time } universeAddBodies :: Universe a → [Body a] → Universe a universeAddBodies u bs = Universe { bodies = (bodies u) ⊕ bs, time = time u } universeCollide :: Universe a → (Body a → [Body a] → [Body a]) → Universe a universeCollide (Universe bs t) f = Universe { bodies = bodiesCollide bs f, time = t } universeEvolve :: Universe a → Time → Universe a universeEvolve u t = Universe { bodies = map (λb → bodyEvolve b t) (bodies u), time = t + (time u) } universeFilter :: (Universe a) → (Body a → Bool) → (Universe a) universeFilter u p = Universe { bodies = filter p (bodies u), time = time u }
Game Module
Now that the physics of the universe have been described, we can start describing specific aspects of the game.
Weapon
Each ship has some number of weapons capable of doing some amount of damage and can fire projectiles with a given acceleration.
data Weapon = Torpedo type Damage = Int weaponDamage :: Weapon → Damage weaponDamage Torpedo = 2 weaponDamage _ = defined type Thrust = Float weaponThrust :: Weapon → Thrust weaponThrust Torpedo = 0.5 weaponThrust _ = undefined
Engine
Each ship has some number of engines capable of providing some amount of acceleration.
data Engine = Rocket engineThrust :: Engine → Thrust engineThrust Rocket = 0.05 engineThrust _ = undefined
Ship
A ship is any body in the universe, described here as either a Projectile or a Fighter. It is what will be captured in the parametric type of the Universe data type.
data Ship = Projectile Thrust Damage | Fighter Engine Weapon shipEngines :: Ship → [Engine] shipEngines (Fighter e _) = [e] shipEngines _ = [] shipThrust :: Ship → Thrust shipThrust s = sum $ map engineThrust (shipEngines s) shipWeapons :: Ship → [Weapon] shipWeapons (Fighter _ w) = [w] shipWeapons _ = [] shipFireWeapons :: Ship → [Ship] shipFireWeapons s = map newProjectile $ shipWeapons s
Projectile
A projectile is any body fired from a weapon.
newProjectile :: Weapon → Ship newProjectile w = Projectile (weaponThrust w) (weaponDamage w) projectileToBody :: Ship → Movement → Body Ship projectileToBody p@(Projectile t d) m@(Movement l v a) = Body { shape = Circle { center = pointAdd l (vectorScale 1.1 vectorUp), radius = 0.2 }, movement = Movement { location = pointAdd l (vectorScale 1.25 vectorUp), velocity = vectorScale t vectorUp, acceleration = vectorIdentity a }, description = p, mass = 1 }
Fighter
The Fighter represents the end user and has a number of functions for controlling it. Notably, firing of the weapons and navigating the plane.
shipIsFighter :: Ship → Bool shipIsFighter (Fighter _ _) = True shipIsFighter _ = False fighterDestroyed :: (Universe Ship) → Bool fighterDestroyed (Universe bs t) = null $ filter (λb → shipIsFighter (description b)) bs fighterMove :: Body Ship → Vector → [Body Ship] fighterMove (Body s mass (Movement l v a) d) direction = [Body { movement = Movement { location = l, velocity = vectorAdd δ v, acceleration = a }, mass = mass, shape = s, description = d }] where δ = vectorScale (shipThrust d) direction fighterFire :: Body Ship → [Body Ship] fighterFire b@(Body s mass m d) = [b] ⊕ bs where bs = map (λx → projectileToBody x m) $ projectiles projectiles = shipFireWeapons d direction = vectorUp universeActOnFighter :: (Universe Ship) → (Body Ship → [Body Ship]) → (Universe Ship) universeActOnFighter u f = Universe { bodies = bodiesActOnFighter (bodies u) f, time = time u } bodiesActOnFighter :: [Body Ship] → (Body Ship → [Body Ship]) → [Body Ship] bodiesActOnFighter [] _ = [] bodiesActOnFighter (b:bs) f = b' ⊕ bs' where b' = bodyActOnFighter b f bs' = bodiesActOnFighter bs f bodyActOnFighter :: Body Ship → (Body Ship → [Body Ship]) → [Body Ship] bodyActOnFighter b f | shipIsFighter $ description b = f b | otherwise = [b]
Graphics Module
The Graphics module deals with mapping the above data types into their corresponding HOpenGL counterparts. (I looked at a number of Haskell’s graphics libraries and ultimately chose to go with HOpenGL since I was the most familiar with OpenGL.)
coordinateToGLfloat :: Coordinate → GLfloat coordinateToGLfloat c = realToFrac c type OpenGLPoint = (GLfloat, GLfloat, GLfloat) pointToOpenGLPoint :: Geometry.Point → OpenGLPoint pointToOpenGLPoint (Geometry.Point x y) = (x', y', 0.0::GLfloat) where x' = coordinateToGLfloat x y' = coordinateToGLfloat y type OpenGLView = [OpenGLPoint] shapeToView :: Shape → OpenGLView shapeToView (Circle c r) = map pointToOpenGLPoint points where points = map (λθ → Geometry.Point (r * (cos θ)) (r * (sin θ))) degrees degrees = map (λn → n * increment ) [0..steps - 1] increment = 2.0 * pi / steps steps = 16 shipToView :: Ship → OpenGLView shipToView (Projectile _ _) = [ ... ] shipToView (Fighter _ _) = [ ... ] shipToView _ = undefined openGLPointTranslate :: OpenGLPoint → OpenGLPoint → OpenGLPoint openGLPointTranslate (x, y, z) (dx, dy, dz) = (x + dx, y + dy, z + dz) openGLViewTranslate :: OpenGLView → OpenGLPoint → OpenGLView openGLViewTranslate xs d = map (openGLPointTranslate d) xs openGLPointToIO :: OpenGLPoint → IO () openGLPointToIO (x, y, z) = vertex $ Vertex3 x y z openGLViewToIO :: OpenGLView → IO () openGLViewToIO ps = mapM_ openGLPointToIO ps displayBody :: Body Ship → IO() displayBody (Body s mass m d) = color (Color3 (1.0::GLfloat) 1.0 1.0) >> renderPrimitive LineLoop ioShip where ioBody = openGLViewToIO $ openGLViewTranslate (shapeToView s) dl ioShip = openGLViewToIO $ openGLViewTranslate (shipToView d) dl dl = pointToOpenGLPoint l l = location m displayUniverse :: Universe Ship → IO () displayUniverse universe = mapM_ displayBody $ bodies universe
Main Module
The Main Module is the glue that brings together all of the other modules. Much of the functions described here are for gluing together the OpenGL callbacks to the functions described above.
theUniverse :: Universe Ship theUniverse = ... main :: IO() main = do (programName, _) ← getArgsAndInitialize initialDisplayMode $= [ DoubleBuffered ] createWindow "Space Cowboy" universe ← newIORef theUniverse displayCallback $= (display universe) idleCallback $= Just (idle universe) keyboardMouseCallback $= Just (keyboardMouse universe) mainLoop display :: IORef (Universe Ship) → IO () display ioRefUniverse = do clear [ ColorBuffer ] loadIdentity scale 0.2 0.2 (0.2::GLfloat) universe ← get ioRefUniverse displayUniverse universe swapBuffers flush idle :: IORef (Universe Ship) → IO () idle ioRefUniverse = do universe ← get ioRefUniverse ioRefUniverse $= stepUniverse universe game threadDelay 10 postRedisplay Nothing stepUniverse :: (Universe Ship) → (Universe Ship) stepUniverse u = collided where collided = universeCollide filtered collide filtered = universeFilter evolved inBounds evolved = universeEvolve u 0.1 collide :: Body Ship → [Body Ship] → [Body Ship] collide b@(Body s mass m (Projectile d t)) xs = [] collide b _ = [b] inBounds :: Body Ship → Bool inBounds b@(Body _ _ (Movement (Geometry.Point x y) _ _) d) | shipIsFighter d = True | otherwise = and [abs x < 10, abs y < 10] keyboardMouse ioRefUniverse key state modifiers position = keyboard ioRefUniverse key state keyboard :: IORef (Universe Ship) → Key → KeyState → IO () keyboard ioRefUniverse (Char 'q') Down = do exitSuccess keyboard ioRefUniverse (Char ' ') Down = fire ioRefUniverse keyboard ioRefUniverse (SpecialKey KeyLeft) Down = navigate ioRefUniverse vectorLeft keyboard ioRefUniverse (SpecialKey KeyRight) Down = navigate ioRefUniverse vectorRight keyboard ioRefUniverse (SpecialKey KeyUp) Down = navigate ioRefUniverse vectorUp keyboard ioRefUniverse (SpecialKey KeyDown) Down = navigate ioRefUniverse vectorDown keyboard _ _ _ = return () fire :: IORef (Universe Ship) → IO() fire ioRefUniverse = do universe ← get ioRefUniverse ioRefUniverse $= universeActOnFighter universe fighterFire navigate :: IORef (Universe Ship) → Vector → IO () navigate ioRefUniverse direction = do universe ← get ioRefUniverse ioRefUniverse $= universeActOnFighter universe (λf → fighterMove f direction)
Wrap-up
For a month of on-again, off-again work, the prototype turned out reasonably well and I got a lot out of it. I think that as I continue to use Haskell, my brain will slowly switch from thinking in terms of structures of data to flows of data and I will ultimately be able to be more productive in Haskell. Until then, I’m going to stick with my current technology stack and continue to experiment with Haskell. Keep an eye for part three of this series which will go over the completed product.
Space Cowboy: A Shoot’em up game in Haskell: Part 1
It’s the start of a new year and January always marks the return of Antimatroid, The. The past few months I’ve been busy working on a number of project around the house and spending some time working on a few projects for around here. This article serves as an introduction to a shoot’em up game that I’ve been working on since July. Future installments will cover the implementation and design aspects of the project.
Introduction
The past few months I’ve been working on a Shoot’em up game in Haskell and decided that I’d gotten to a point where a writeup was in order. I’ve always enjoyed the genre and I wanted to create something with a degree of complexity greater than my previous arcade games. Along the same lines, I decided to go with Haskell so that I could get a better hang of the language and build something tangible and practical beyond the utilities and solvers I’ve written. The title of the game is a nod to various Space Westerns that inspired me to get started. The following writeup goes over the software development process I applied to the project from specification to implementation.
Specification
Space Cowboy is a single player game consisting of a sequence of levels. The user starts on the first level and plays until he or she has completed the level and progresses onto the next level and so on. Once there are no more levels left, the user has won the game. If a user fails to complete a level, then the game is over. Each level is of a fixed length and contains a fixed number of opponents. To complete a level, the user either gets to the end of the level or destroys all of the opponents. If an opponent destroys the user, then the user does not complete the level and the game is over.
The user and the opponents are represented by ships. Ships start with a fixed number of hit points and lose hit points any time the ship is attacked or it collides with another ship. Once a ship has lost enough hit points to match its initial hit points, then it is considered destroyed. Ships can attack one another using weapons that come in a variety of rates of fire and magnitude of damage. Each ship can can maneuver around the level using engines that come in a variety of thrusts and rates of propulsion. The user’s ship can be maneuvered left, right, up and down and instructed to fire its weapons. Opponents ships are maneuvered by the game. Ships can improve their abilities by colliding with power-ups which upgrade weapons, engines and hit points. Power-ups are produced randomly whenever a ship is destroyed.
A score system keeps track of the user’s progress. When the user starts the game, his or her score is set to zero and increases as he or she plays each level. Whenever a user gets a power-up or destroys a ship, then their score increments proportionally to the magnitude of the power-up or ship destroyed. A user’s score is never decremented. The user is incentivised to play again to obtain a higher score than his or her previous trial.
Requirements
User Interface
The user interface will be a portfolio view consisting of four screens:
- Logo Screen: displays the developer’s logo and copyright information
- Menu Screen: allows the user to start a new game, view high scores and exit the application
- Game Screen: contains information about what level the user is on, their score, the number of lives they have left and the view of the game universe
- High Scores Screen: contains a list of the top five high scores achieved in the game
When the application starts, the user will see the Logo Screen which will transition to the Main Menu Screen after a few seconds. When the user presses the New Game Button, the application will go to the Game Screen. When the user presses the High Scores Button, the application will go to the High Scores Screen. When a user completes their game, they will transition to the High Scores Screen. If the user has a new high score, they will be asked to enter the name they want to associate with the score. The user may go back to the Main Menu Screen by clicking on the Menu Button.
Gameplay
The game universe is a simplified model of the physical universe. The game universe has two spatial dimensions and one temporal dimension. Both spatial dimensions are bounded and residents of the game universe may not exist outside of those boundaries. When the game starts, the user will be at one extreme of these boundaries and must reach the other extreme to complete the level.
Every resident in the game universe has a dimension, heading and location. No two residents of the game universe may occupy the same space at the same time. When two residents collide, their resulting motions will follow Newton’s laws of motion. If the damage done on either body during the collision is material, then the body will be reduced to debris and power-ups.
When a ship fires its engines, the thrust of the engine will advance the ship in the direction indicated by the user with respect to the ship’s heading. When the ship fires its weapons, the ship will experience kickback in accordance with Newton’s third law of motion. As the user’s ship moves through the game universe, the view of the game universe will be centered on the user’s ship.
Haskell ecosystem on Windows XP
It’s been fun watching the Haskell ecosystem evolve into a mature system over the years. Seems that about every three months it takes a leap forward and I usually find myself uninstalling what I previously had and putting the latest and greatest on my laptop. To save myself some time in the future, I’ve compiled this post as a reference of basic “stuff” that is good to have for doing Haskell development on a Windows XP machine.
Haskell Platform
It used to be that you had to go find a number of different applications to get packages, compile source code and generate documents (among a handful of other things), then a group of folks identified an opportunity and put together a platform for getting new users a place to start. The result is the Haskell Platform.
- Glasgow Haskell Compiler (GHC) – The Haskell compiler that also comes with a command line interpreter (GHCi). Alternatives are the York Haskell Compiler (yhc) and Hugs
- Cabal – Basic package management system
- Haddock – used for generating documentation based on comments in source code
After installing, you’ll want to go to the command line and run the following commands to make sure that you’ve got the latest version of Cabal and to make sure that it has the latest package list:
C:\cabal install cabal-install C:\cabal update
Leksah
Many developers are probably used to having a quality Integrated Development Environment (IDE) to work with and the Haskell Community’s answer is Leksah. Leksah is still fairly green and has a ways to go before being comparable to Eclipse or Visual Studio, but nonetheless, Leksah is packed with plenty of goodies that will make for easy development of packages and modules for distribution on Cabal.
It is best to use the installer from the Leksah website. Once you’ve installed the latest, you’ll need to run the following from the command-line
C:\ghc-pkg recache
So that the packages on the system (those provided by GHC) will show up when you have the browse pane open.
Gtk2hs
If you plan on doing any Graphical User Interfaces (GUIs), then you’ll want to get the Haskell binding to the GTK+ library. On the page there should be an “All-in-one bundle”- for the purpose of the following, I went with version 2.20.
After extracting the bundle on the machine, make sure that the path you extracted the bundle at along with the child bin directory is added to the PATH environment variable.
Then from the command-line run the following and you should be able to include GTK in your project:
C:\cabal install gtk
HOpenGL
I’ve been working on some basic game programming and I’ve done some stuff in the past with OpenGL so I decided to give the Haskell bindings a try. Windows doesn’t natively ship with the OpenGL library, so you’ll need to get it from here.
Then get the following packages off of Cabal:
c:\cabal install glut C:\cabal install opengl
Wrap-up
I haven’t done a dry run to test all of the above, so if you follow all of the above and come across a problem, post the solution in the comments. I’ll continue to update this post as I identify any problems or come across additional “stuff” that falls into the must-have category.
Sudoku Solver in Haskell
This month will be a bit of short article since I haven’t had a whole lot of time on my hands lately. Haskell is a wonderful little language that has begun to pick up a bit of moment in the past year that I’ve been playing with on-and-off now for several years. Since I don’t post enough on Haskell, I figured I’d post my bare-bones Haskell Sudoku Solver.
import Data.List import Data.Maybe toRowColumn :: Int -> (Int, Int) toRowColumn index = (r, c) where r = div index 9 c = mod index 9 toIndex :: (Int, Int) -> Int toIndex (r, c) = r * 9 + c toRegion :: (Int, Int) -> Int toRegion (r, c) = (div r 3) * 3 + (div c 3) columnIndicies :: Int -> [Int] columnIndicies c = [c, c + 9..80] regionIndicies :: Int -> [Int] regionIndicies g = [toIndex(r + x, c + y) | x <- [0..2], y <- [0..2] ] where r = (div g 3) * 3 c = (mod g 3) * 3 rowIndicies :: Int -> [Int] rowIndicies r = [9 * r..9 * (r + 1) - 1] values :: [Int] -> [Int] -> [Int] values board indicies = filter (>0) (map (board!!) indicies) possibleValues :: [Int] -> (Int, Int) -> [Int] possibleValues board rowColumn = foldl (\\) [1..9] ( map (values board) ( map (\f -> (fst f . snd f) rowColumn) ( zip [rowIndicies, columnIndicies, regionIndicies] [fst, snd, toRegion] ) ) ) validBoard :: [Int] -> Bool validBoard board = (length board == 81) && (and $ map (==0) l) where l = map length s s = map (\\[1..9]) v v = [values board (xIndicies x) | x <- [0..8], xIndicies <- [rowIndicies, columnIndicies, regionIndicies]] solvedBoard :: [Int] -> Bool solvedBoard board = and $ map (>0) board hasUnassigned :: [Int] -> Bool hasUnassigned board = isJust $ elemIndex 0 board assignFirstUnassigned :: [Int] -> Int -> [Int] assignFirstUnassigned (b:bs) value | b == 0 = value : bs | otherwise = b : (assignFirstUnassigned bs value) possibleBoards :: [Int] -> [Int] -> [[Int]] possibleBoards board possibleAssignments = map (assignFirstUnassigned board) possibleAssignments solve :: [Int] -> [[Int]] solve board | not (validBoard board) = [[]] | solvedBoard board = [board] | not (hasUnassigned board) = [[]] | otherwise = concated where concated = concat mapped mapped = map solve filtered filtered = filter (not . null) possibleSolved possibleSolved = possibleBoards board possibleAssignments possibleAssignments = possibleValues board unassignedRowColumn unassignedRowColumn = toRowColumn unassignedIndex unassignedIndex = fromJust $ elemIndex 0 board demo :: [Int] demo = [2,0,0,0,8,0,3,0,0, 0,6,0,0,7,0,0,8,4, 0,3,0,5,0,0,2,0,9, 0,0,0,1,0,5,4,0,8, 0,0,0,0,0,0,0,0,0, 4,0,2,7,0,6,0,0,0, 3,0,1,0,0,7,0,4,0, 7,2,0,0,4,0,0,6,0, 0,0,4,0,1,0,0,0,3]