１１．Asteroids
アステロイド・ゲームはアタリ社（米国）が1979年に作成したゲームである。当時は、アーケードと呼ばれたが、ゲームができる専門店があり、店には一人がけのゲーム専用機が設置されていた。そこで遊べるゲームをアーケード・ゲームと呼んでいた。なかでも、スペース・インベーダーは人気のあるゲームであった。
ここでは、簡易版のアステロイド・ゲームを紹介する。ゲームは次のようになっている。長方形の画面の上の方からは、隕石(asteroids)が落ちてくる。下には、宇宙船が用意されていて、左右に動かせる。宇宙船に隕石が当たると隕石が爆発する。
１１．１ プログラムの構成
プログラムを解読する前は、複雑なコードではと危惧していたが、あまりにも単純なのでびっくりした。プログラムは次のように構成になっている。
時間とともに、隕石が上の方から落ちてくるが、隕石の発生確率と隕石の横方向での位置は乱数から作り出される。隕石は等速で落下するのだが、それぞれの時間での落下位置を計算によって求めるのではなく、単位時間（プログラムではインターバルとなっている）の整数倍ごとに落下位置を求めておき、それをリストにして用意する。単位時間が経過するごとにリストの先頭要素にあるものを読み込み、それをその時の位置とする。また、読みだされた先頭要素はリストから捨てられ、次の時間での落下位置が先頭として現れる。
宇宙船と隕石の衝突は、中心間の距離が与えられたある値よりも小さくなったかどうかにより判断される。小さくなったときは、隕石の画像は炎上した画像に代わり、衝突音も発生する。
１１．２ ユーザ・インタフェース
まず、プログラムで使用する定数（画面の大きさheight,width、衝突を発生する長さdiameter、隕石の発生確率chance）、画像（隕石rock、炎上した隕石burning、宇宙船ship）、音声（衝突時explode）を用意する。
height, width, diameter :: Int height = 300 width = 300 diameter = 24 chance :: Double chance = 0.1 rock, burning, ship :: Bitmap () rock = bitmap $ getDataFile "rock.ico" burning = bitmap $ getDataFile "burning.ico" ship = bitmap $ getDataFile "ship.ico" explode :: WXCore.Sound () explode = sound $ getDataFile "explode.wav"
それでは、ユーザ・インタフェースを定める。
画面には、ゲームのほかに、ゲームを停止したり、終了させたりするメニューや、現在落下中の隕石の数を表示する。
例によってフレームを用意する。フレームにはAsteroidsというタイトルをつける。
ff <- frame [ text := "Asteroids" , bgcolor := white , resizeable := False ]
落下中の隕石の数を示すstatusBarは次のように設定する。なお、最初の表示は隕石の数ではなく"Welcome to Asteroids"となっている。
status <- statusField [text := "Welcome to asteroids"] set ff [statusBar := [status]]
また、50ミリ秒間隔のタイマーも用意する。
t <- timer ff [ interval := 50 ]
停止や終了を支持するためのメニューは次のようにする。
game <- menuPane [ text := "&Game" ] new <- menuItem game [ text := "&New\tCtrl+N", help := "New game" ] pause <- menuItem game [ text := "&Pause\tCtrl+P" , help := "Pause game" , checkable := True ] menuLine game quit <- menuQuit game [help := "Quit the game"] set new [on command := asteroids] set pause [on command := set t [enabled :~ not]] set quit [on command := close ff] set ff [menuBar := [game]]
最後に、パネルを用意し、フレームに物理的な大きさを定義し、また、インターバルを長くしたり縮めたりできるようにする。これは、-あるいは+のボタンで行う。
pp <- panel ff [] set ff [ layout := minsize (sz width height) $ widget pp ] set pp [ on (charKey '-') := set t [interval :~ \i -> i * 2] , on (charKey '+') := set t [interval :~ \i -> max 10 (div i 2)] ]
１１．３ イベント・ネットワークの構成
入力
入力は、タイマーからのイベントetickと、宇宙船を左右に動かすためのキーからのイベントekeyである。これらは次のように表すことができる。
-- timer etick <- event0 t command -- keyboard events ekey <- event1 pp keyboard
イベント・グラフ
イベント・グラフは、宇宙船、隕石、描画の振舞いである。
宇宙船は、左右のキーを押すことで、左右に移動するので、これらの動きを蓄積したものとして次のように表す。なお、最初の位置は真ん中である。また、左あるいは右のキーを押しても横端からはみでないようにする。
let eleft = filterE ((== KeyLeft ) . keyKey) ekey eright = filterE ((== KeyRight) . keyKey) ekey -- ship position (bship :: Behavior Int) <- accumB (width `div` 2) $ unions [ goLeft <$ eleft , goRight <$ eright ] let goLeft x = max 0 (x - 5) goRight x = min (width-30) (x + 5)
次は隕石の振舞いである。隕石には、落下中の隕石と乱数により生成する隕石の二種類がある。
乱数を利用して、隕石を生成する方から考える。乱数（0から1の間の小数）の値が、0.1未満の時、隕石は生成され、その値は横方向での位置を与える。0.1以上の時は隕石は発生しない。したがって、隕石の発生確率は10%である。
隕石の生成は、newRockという関数で実行される。newRockは、乱数の値を用いてx軸（横方向）での位置を得た後、trackという関数を用いて、生成後以降の落下位置を、インターバルによる時間の経過に合わせて、リストにして出力する。
落下中の隕石は関数advanceRocksにより処理される。この関数は、次のインターバルに達した時、空リストでなければ、先頭の要素を取り除く。これは、次の時間での隕石の位置をリストの先頭にするための処理である。
この二つをまとめると隕石の振舞いが求められるので次のようになる。
(brocks :: Behavior [Rock]) <- accumB [] $ unions [ advanceRocks <$ etick , newRock <$> filterE (< chance) (brandom <@ etick) ]
描画の振舞いは、宇宙船と隕石の位置を求める。また、宇宙船と衝突している隕石も検出する。得られ位置で宇宙船と隕石を描画するが、衝突している隕石に対しては炎上している画像を描画する。
bpaint <- stepper (\_dc _ -> return ()) $ (drawGameState <$> bship <*> brocks) <@ etick
出力
出力は、描画の振舞いをに従って描けばよいので次のようになる。
sink pp [on paint :== bpaint] reactimate $ repaint pp <$ etick
そのほかに落下中の隕石の数を出力する。これは次のようになる。
-- status bar let bstatus :: Behavior String bstatus = (\r -> "rocks: " ++ show (length r)) <$> brocks sink status [text :== bstatus]
１１．４ 関数
上記の記述で説明した関数は次のようになっている。隕石はデータ型Rockで表される。Rockは、これまで説明したように、これからの落下位置のリストである。落下位置は、データ型Positionで表される。これはPoint2型である。
また、関数newRock,track,advanceRocksは前に説明した通り、隕石を新たに用意するもの、新しい隕石のためにこれからの落下位置のリストを作るもの、インターバルが一つ進んだ時の落下位置をリストの先頭に持ってくるものである。
-- rock logic type Position = Point2 Int type Rock = [Position] -- lazy list of future y-positions newRock :: Double -> [Rock] -> [Rock] newRock r rs = (track . floor $ fromIntegral width * r / chance) : rs track :: Int -> Rock track x = [point x (y - diameter) | y <- [0, 6 .. height + 2 * diameter]] advanceRocks :: [Rock] -> [Rock] advanceRocks = filter (not . null) . map (drop 1)
drawGameStateは宇宙線、隕石を描くもので、隕石が宇宙船に衝突しているときは、炎上している画像と爆発音を発生する。
-- draw game state drawGameState :: Int -> [Rock] -> DC a -> b -> IO () drawGameState ship rocks dc _view = do let shipLocation = point ship (height - 2 * diameter) positions = map head rocks collisions = map (collide shipLocation) positions drawShip dc shipLocation mapM (drawRock dc) (zip positions collisions) when (or collisions) (play explode) collide :: Position -> Position -> Bool collide pos0 pos1 = let distance = vecLength (vecBetween pos0 pos1) in distance <= fromIntegral diameter drawShip :: DC a -> Point -> IO () drawShip dc pos = drawBitmap dc ship pos True [] drawRock :: DC a -> (Point, Bool) -> IO () drawRock dc (pos, collides) = let rockPicture = if collides then burning else rock in drawBitmap dc rockPicture pos True []
