第9章 対話プログラム #8

9.9 練習問題

4. ライフゲームのボードを対話的に作成したり、変更したりできるエディターを作れ。

9.7で写経したライフゲームを修正して、ボードサイズを可変にできるようにしてやったぜ。

module NineNineFour where

import System.IO
import NineFive

getCh :: IO Char
getCh =  do hSetEcho stdin False
            c <- getChar
            hSetEcho stdin True
            return c

-- variable size

type Board = [Pos]
type Size  = Pos

showcells   :: Board -> IO ()
showcells b =  seqn [writeat p "O" | p <- b]

isAlive     :: Board -> Pos -> Bool
isAlive b p =  elem p b

isEmpty     :: Board -> Pos -> Bool
isEmpty b p =  not (isAlive b p)

neighbs         :: Size -> Pos -> [Pos]
neighbs s (x,y) =  map (wrap s)
                     [(x-1,y-1), (x,y-1), (x+1,y-1),
                      (x-1,y),            (x+1,y),
                      (x-1,y+1), (x,y+1), (x+1,y+1)]

wrap             :: Size -> Pos -> Pos
wrap (w,h) (x,y) =  (((x-1) `mod` w) + 1, ((y-1) `mod` h) + 1)

liveneighbs      :: Size -> Board -> Pos -> Int
liveneighbs s b  =  length . filter (isAlive b) . neighbs s

survivors     :: Size -> Board -> [Pos]
survivors s b =  [p | p <- b, elem (liveneighbs s b p) [2,3]]

births     :: Size -> Board -> [Pos]
births s b =  [p | p <- rmdups (concat (map (neighbs s) b)),
                   isEmpty b p,
                   liveneighbs s b p == 3]

rmdups        :: Eq a => [a] -> [a]
rmdups []     =  []
rmdups (x:xs) =  x:rmdups (filter ((/=) x) xs)

nextgen     :: Size -> Board -> Board
nextgen s b =  survivors s b ++ births s b

life     :: Size -> Board -> IO ()
life s b =  do
  cls
  showcells b
  wait 5000
  life s (nextgen s b)

wait   :: Int -> IO ()
wait n =  seqn [return () | _ <- [1..n]]

-- board maker

runlife     :: Int -> Int -> IO ()
runlife w h =  makeboard (w,h) [] (1,1)

makeboard       :: Size -> Board -> Pos -> IO ()
makeboard s b p =  do
  cls
  showcells b
  goto p
  c <- getCh
  process s b p c

move                   :: Size -> Pos -> Pos -> Pos
move s (dx,dy) (px,py) =  wrap s (px+dx,py+dy)

up    = ( 0, -1)
down  = ( 0,  1)
right = ( 1,  0)
left  = (-1,  0)

process      :: Size -> Board -> Pos -> Char -> IO ()
process s b p c
  | elem c "\n" = life s b
  | elem c " "  = makeboard s (flippos p b) p
  | elem c "c"  = makeboard s [] p
  | elem c "k"  = makeboard s b (move s up p)
  | elem c "j"  = makeboard s b (move s down p)
  | elem c "h"  = makeboard s b (move s left p)
  | elem c "l"  = makeboard s b (move s right p)
  | otherwise   = makeboard s b p

flippos     :: Pos -> Board -> Board
flippos p b =  if elem p b
               then [q | q <- b, q /= p]
               else p : b