Sunday, August 10, 2014

nibbles

Remember this game?
import Graphics.UI.SDL as SDL hiding (init)
import System.Random.Mersenne.Pure64 (newPureMT, randomInt)
import Control.Monad (join, replicateM)
import Control.Arrow ((***))
import Data.List (unfoldr)

[xres, yres, unit] = map (12 *) [90, 50, 1]

main = withInit [InitVideo] $ do
  window <- setVideoMode xres yres 32 []
  seeds  <- replicateM 2 newPureMT
  enableEvent SDLMouseMotion False
  setCaption "Nibbles" "Nibbles"
  run window 8 (rands seeds) snake right
 where
  snake = [unscale (xres `div` 2, yres `div` 2)]
 
run w n (r:rs) s@(p:ps) d@(x,y) = if dead s then end else do
  delay 48
  render w r s
  e <- pollEvent
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> end
   KeyUp (Keysym SDLK_UP _ _)     -> go $ d == down  ? (d, up)
   KeyUp (Keysym SDLK_RIGHT _ _)  -> go $ d == left  ? (d, right)
   KeyUp (Keysym SDLK_DOWN _ _)   -> go $ d == up    ? (d, down)
   KeyUp (Keysym SDLK_LEFT _ _)   -> go $ d == right ? (d, left)
   _                              -> go d
 where
  end = putStrLn $ "Score: " ++ show (length s - 9)
  go  = run w n' rs' $ f p : (n > 0 ? (s, init s))
  rs' = r == scale p ? (rs, r:rs)
  n'  = r == scale p ? (7, n - 1)
  f   = (x+) *** (+y)
 
render w r ps = do
  s <- createRGBSurface [SWSurface] unit unit 32 0 0 0 0
  fillRect w (Just $ Rect 0 0 xres yres) (Pixel 0)
  mapM_ (draw s 0xFFFFFF . scale) ps
  draw s 0x00FF00 r
  SDL.flip w
 where
  rect (x,y) = Just $ Rect x y unit unit
  draw s c p = do fillRect s Nothing $ Pixel c
                  blitSurface s Nothing w $ rect p

dead (p:ps) = p `elem` ps || exterior (scale p)
 where
  exterior (x,y) = or [x < 0, y < 0, x >= xres, y >= yres]

rands [g, g'] = map (scale . unscale) $ zip xs ys
 where
  xs = map (`mod` xres) $ unfoldr (Just . randomInt) g
  ys = map (`mod` yres) $ unfoldr (Just . randomInt) g'

scale   = join (***) (* unit)
unscale = join (***) (`div` unit)

[up, right, down, left] = zip [0, 1, 0, -1] [-1, 0, 1, 0]

p ? (a,b) = if p then a else b; infix 2 ?

No comments:

Post a Comment