DIY HOBBY ELEC

MDN ブロックくずしゲームでウェブゲーム開発に入門してみた。その６

by AKIHIRO YAMAMOTO | Published on 2022-05-01

このプログラムはGitHub Pagesで公開しています。

MDN web docs にある 「そのままのJavaScriptを使ったブロックくずしゲーム」 の６番目のステップ。

lesson06

aki:~/breakout$ cp -r lesson05/ lesson06
aki:~/breakout$ cd lesson06/
aki:~/breakout/lesson06$

lesson05 をコピーした lesson06 を用意して続きを始める。

今回は ブロックのかたまりを作る

ブロック変数を設定する

このレッスンのおおまかな目標は、ブロックのための、2次元配列を走査する入れ子のループを使った数行のコードを書き上げることです。しかしその前に幅と高さ、行と列などといった情報を定義するいくつかの変数が必要です。自分のコードの、以前変数を宣言した場所の下に次のコードを追加してください。

var brickRowCount = 3;
var brickColumnCount = 5;
var brickWidth = 75;
var brickHeight = 20;
var brickPadding = 10;
var brickOffsetTop = 30;
var brickOffsetLeft = 30;

ここではブロックの行と列の数、幅と高さ、ブロックがくっつかないようにするブロック間の隙間、そしてキャンバスの端に描画されないようにするための上端、左端からの相対位置を定義しました。

1つの2次元配列で全てのブロックを記録します。2次元配列はブロックの列 (c) を含んでおり、列は行 (r) を含み、行はそれぞれのブロックが描画される画面上のx座標とy座標をもつオブジェクトを含んでいます。

こういうのみんなInt型定数でいいな。

brickRowCount = 3 :: Int

brickColumnCount = 5 :: Int

brickWidth = 75 :: Int

brickHeight = 20 :: Int

brickPadding = 10 :: Int

brickOffsetTop = 30 :: Int

brickOffsetLeft = 30 :: Int

これがＣ言語なら仕方ないけど書き換えできる２次元配列の取り扱いはかなり難度が高いので, bricksには{row,column}をキーにした連想配列を使うことにする。

ここでMapとHashMapで迷ったけど

どっちを選んでもできそうなので, とりあえずData.Mapを使おう。

これをkeyにして。

newtype BricksIndex
  = BricksIndex { row :: Int, column :: Int }

これをvalueに。

newtype Brick
  = Brick { x :: Number, y :: Number }

これがbricks。

bricks :: Map BricksIndex Brick

var bricks = [];
for(var c=0; c<brickColumnCount; c++) {
    bricks[c] = [];
    for(var r=0; r<brickRowCount; r++) {
        bricks[c][r] = { x: 0, y: 0 };
    }
}

上記のコードは行と列を通してループし、新しいブロックを作ります。このブロックオブジェクトは後に衝突検出のためにも使われることを覚えておいてください。

初期化は空Mapを用意すればいいでしょ。

initialState :: forall i. i -> State
initialState _ =
  { maybeCanvas: Nothing
  , maybeTimer: Nothing
  , dataset:
      { x: 0.0
      , y: 0.0
      , dx: 0.0
      , dy: 0.0
      , paddleX: 0.0
      , leftPressed: false
      , rightPressed: false
      , bricks: Map.empty
      }
  }

赤線が、ね。 lesson06-1

  No type class instance was found for

    Data.Show.Show BricksIndex


while solving type class constraint

  Data.Show.Show (Map BricksIndex Brick)

while applying a function show
  of type Show t0 => t0 -> String
  to argument state.dataset
while checking that expression show (state.dataset)
  has type String
in value declaration render

where t0 is an unknown type

そこで指摘されている通り, 型クラス Data.Show.Showのクラスメソッドであるshowの引数は 型クラスData.Show.Showのインスタンスである制約があるので 「BricksIndexのインスタンスが見つかりませんよ」と教えてくれている。

参考(Haskellの例)

BricksIndex型を型クラス Data.Show.Showのインスタンスにすればいい。

derive newtype instance showBricksIndex :: Show BricksIndex

続いて

  No type class instance was found for

    Data.Show.Show Brick


while solving type class constraint

  Data.Show.Show (Map BricksIndex Brick)

while applying a function show
  of type Show t0 => t0 -> String
  to argument state.dataset
while checking that expression show (state.dataset)
  has type String
in value declaration render

where t0 is an unknown type

同じようにShow型クラスのインスタンスを用意する。

derive newtype instance showBrick :: Show Brick

ブロック描画ロジック

配列に含まれる全てのブロックを通してループする関数を作成し、画面上に描画しましょう。コードは次のようになります。

function drawBricks() {
    for(var c=0; c<brickColumnCount; c++) {
        for(var r=0; r<brickRowCount; r++) {
            bricks[c][r].x = 0;
            bricks[c][r].y = 0;
            ctx.beginPath();
            ctx.rect(0, 0, brickWidth, brickHeight);
            ctx.fillStyle = "#0095DD";
            ctx.fill();
            ctx.closePath();
        }
    }
}

もう一度、行と列を通してループし、それぞれのブロックのx座標とy座標を設定するとともに、1回ループを回るごとに大きさbrickWidth x brickHeightのブロックをCanvas上に描画しています。問題はそれら全てを1箇所、座標(0,0)に描画していることです。それぞれのブロックのx座標とy座標を導出する計算を一回一回のループに含める必要があります

var brickX = (c*(brickWidth+brickPadding))+brickOffsetLeft;
var brickY = (r*(brickHeight+brickPadding))+brickOffsetTop;

それぞれの座標brickXはbrickWidth + brickPaddingに列番号cをかけ、brickOffsetLeftをたしたものとして導出されます。brickYのロジックも同様ですが、行番号r、brickHeight、そしてbrickOffsetTopが用いられます。これで、それぞれのブロックは正しい行、列に間隔を空けて置かれ、左上端から一定の位置に描画されるようになりました。

次のようにbrickXとbrickYの値を(0,0)の代わりに座標として代入するようにしたものがdrawBricks()の最終版となります。これをdrawPaddle()関数の下に追加してください。

function drawBricks() {
    for(var c=0; c<brickColumnCount; c++) {
        for(var r=0; r<brickRowCount; r++) {
            var brickX = (c*(brickWidth+brickPadding))+brickOffsetLeft;
            var brickY = (r*(brickHeight+brickPadding))+brickOffsetTop;
            bricks[c][r].x = brickX;
            bricks[c][r].y = brickY;
            ctx.beginPath();
            ctx.rect(brickX, brickY, brickWidth, brickHeight);
            ctx.fillStyle = "#0095DD";
            ctx.fill();
            ctx.closePath();
        }
    }
}

ブロックの表示とブロックの位置を更新する関数を一緒にするのはよくないので分離しましょ。

  drawBricks :: Map BricksIndex Brick -> Effect Unit
  drawBricks bricks =
    for_ bricks \(Brick brick) -> do
      ctx <- Canvas.getContext2D canvas
      Canvas.beginPath ctx
      Canvas.rect ctx
        $ { x: brick.x
          , y: brick.y
          , width: Int.toNumber brickWidth
          , height: Int.toNumber brickHeight
          }
      Canvas.setFillStyle ctx "#0095DD"
      Canvas.fill ctx
      Canvas.closePath ctx

  coordinateBricks :: Map BricksIndex Brick -> Map BricksIndex Brick
  coordinateBricks bricks =
    ST.run do
      var <- STRef.new bricks
      for 0 brickColumnCount \c ->
        for 0 brickRowCount \r ->
          let
            key = BricksIndex { row: r, column: c }

            value = Brick (coord key)
          in
            STRef.modify (Map.insert key value) var
      STRef.read var
    where
    coord :: BricksIndex -> { x :: Number, y :: Number }
    coord (BricksIndex { row: r, column: c }) =
      { x: (c * (brickWidth + brickPadding)) + brickOffsetLeft # Int.toNumber
      , y: (r * (brickHeight + brickPadding)) + brickOffsetTop # Int.toNumber
      }

エラーがでた。

  No type class instance was found for

    Data.Ord.Ord BricksIndex


while applying a function insert
  of type Ord t0 => t0 -> t1 -> Map t0 t1 -> Map t0 t1
  to argument key
while inferring the type of insert key
in value declaration draw

where t0 is an unknown type
      t1 is an unknown type

Show型クラスのときと同じようにOrd型クラスのインスタンスを用意する。

derive newtype instance ordBricksIndex :: Ord BricksIndex

こんどは警告がでた。

  The derived newtype instance for

    Data.Ord.Ord BricksIndex

  does not include a derived superclass instance for Data.Eq.Eq.

型クラスOrdは型クラスEqを継承しているから型クラスEqのインスタンスも必要。 ここらへんHaskellと同じ。

module Breakout (component) where

import Prelude
import CSS (background, block, display, margin, marginBottom, marginLeft, marginRight, marginTop, padding, px, rgb)
import CSS.Common (auto)
import Control.Monad.Rec.Class (forever)
import Control.Monad.ST (for)
import Control.Monad.ST as ST
import Control.Monad.ST.Ref as STRef
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Time.Duration (Milliseconds(..))
import Data.Traversable (for_)
import Effect (Effect)
import Effect.Aff as Aff
import Effect.Aff.Class (class MonadAff)
import Graphics.Canvas (CanvasElement, Dimensions)
import Graphics.Canvas as Canvas
import Halogen (SubscriptionId)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.CSS (style)
import Halogen.HTML.Properties as HP
import Halogen.Query.Event (eventListener)
import Halogen.Subscription as HS
import Math as Math
import Web.Event.Event as E
import Web.HTML (window)
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.Location as Location
import Web.HTML.Window as Window
import Web.UIEvent.KeyboardEvent as KE
import Web.UIEvent.KeyboardEvent.EventTypes as KET

canvasId :: String
canvasId = "myCanvas"

paddleHeight = 10.0 :: Number

paddleWidth = 75.0 :: Number

ballRadius = 10.0 :: Number

brickRowCount = 3 :: Int

brickColumnCount = 5 :: Int

brickWidth = 75 :: Int

brickHeight = 20 :: Int

brickPadding = 10 :: Int

brickOffsetTop = 30 :: Int

brickOffsetLeft = 30 :: Int

newtype BricksIndex
  = BricksIndex { row :: Int, column :: Int }

derive newtype instance showBricksIndex :: Show BricksIndex

derive newtype instance ordBricksIndex :: Ord BricksIndex

derive newtype instance eqBricksIndex :: Eq BricksIndex

newtype Brick
  = Brick { x :: Number, y :: Number }

derive newtype instance showBrick :: Show Brick

type Dataset
  = { x :: Number
    , y :: Number
    , dx :: Number
    , dy :: Number
    , paddleX :: Number
    , leftPressed :: Boolean
    , rightPressed :: Boolean
    , bricks :: Map BricksIndex Brick
    }

type State
  = { maybeCanvas :: Maybe CanvasElement
    , maybeTimer :: Maybe SubscriptionId
    , dataset :: Dataset
    }

data Action
  = Initialize
  | Tick
  | HandleKeyDown KE.KeyboardEvent
  | HandleKeyUp KE.KeyboardEvent

component :: forall query input output m. MonadAff m => H.Component query input output m
component =
  H.mkComponent
    { initialState
    , render
    , eval:
        H.mkEval
          $ H.defaultEval
              { handleAction = handleAction
              , initialize = Just Initialize
              }
    }

initialState :: forall i. i -> State
initialState _ =
  { maybeCanvas: Nothing
  , maybeTimer: Nothing
  , dataset:
      { x: 0.0
      , y: 0.0
      , dx: 0.0
      , dy: 0.0
      , paddleX: 0.0
      , leftPressed: false
      , rightPressed: false
      , bricks: Map.empty
      }
  }

render :: forall m. State -> H.ComponentHTML Action () m
render state =
  HH.main
    [ style do
        margin (px 0.0) (px 0.0) (px 0.0) (px 0.0)
        padding (px 0.0) (px 0.0) (px 0.0) (px 0.0)
    ]
    [ HH.canvas
        [ style do
            background (rgb 238 238 238)
            display block
            marginTop (px 0.0)
            marginRight auto
            marginBottom (px 0.0)
            marginLeft auto
        , HP.id canvasId
        , HP.width 480
        , HP.height 320
        ]
    , HH.text $ show state.dataset
    ]

handleAction :: forall output m. MonadAff m => Action -> H.HalogenM State Action () output m Unit
handleAction = case _ of
  Initialize -> do
    -- keyboard event
    document <- H.liftEffect $ Window.document =<< window
    H.subscribe' \_ ->
      eventListener
        KET.keydown
        (HTMLDocument.toEventTarget document)
        (map HandleKeyDown <<< KE.fromEvent)
    H.subscribe' \_ ->
      eventListener
        KET.keyup
        (HTMLDocument.toEventTarget document)
        (map HandleKeyUp <<< KE.fromEvent)
    -- timer
    sid <- H.subscribe =<< timer Tick
    --
    init <- H.liftEffect initialize
    H.put init { maybeTimer = Just sid }
  Tick -> do
    (state :: State) <- H.get
    case { a: state.maybeCanvas, b: state.maybeTimer } of
      { a: Just canvas, b: Just timerSubscriptionId } -> do
        ret <- H.liftEffect $ draw canvas state.dataset
        if ret.gameover then do
          H.liftEffect $ Window.alert "GAME OVER" =<< window
          H.liftEffect $ Location.reload =<< Window.location =<< window
          H.unsubscribe timerSubscriptionId
        else
          H.modify_ \st -> st { dataset = ret.nextDataset }
      _ -> pure unit
  HandleKeyDown ev
    | KE.key ev == "Right" || KE.key ev == "ArrowRight" -> do
      H.liftEffect $ E.preventDefault (KE.toEvent ev)
      H.modify_ \st -> st { dataset { rightPressed = true } }
    | KE.key ev == "Left" || KE.key ev == "ArrowLeft" -> do
      H.liftEffect $ E.preventDefault (KE.toEvent ev)
      H.modify_ \st -> st { dataset { leftPressed = true } }
    | otherwise -> pure unit
  HandleKeyUp ev
    | KE.key ev == "Right" || KE.key ev == "ArrowRight" -> do
      H.liftEffect $ E.preventDefault (KE.toEvent ev)
      H.modify_ \st -> st { dataset { rightPressed = false } }
    | KE.key ev == "Left" || KE.key ev == "ArrowLeft" -> do
      H.liftEffect $ E.preventDefault (KE.toEvent ev)
      H.modify_ \st -> st { dataset { leftPressed = false } }
    | otherwise -> pure unit
  where
  initialize :: Effect State
  initialize =
    Canvas.getCanvasElementById canvasId
      >>= case _ of
          Nothing -> pure $ initialState unit
          Just canvas -> do
            dim <- Canvas.getCanvasDimensions canvas
            pure
              { maybeCanvas: Just canvas
              , maybeTimer: Nothing
              , dataset:
                  { x: dim.width / 2.0
                  , y: dim.height - 30.0
                  , dx: 2.0
                  , dy: (-2.0)
                  , paddleX: (dim.width - paddleWidth) / 2.0
                  , leftPressed: false
                  , rightPressed: false
                  , bricks: Map.empty
                  }
              }

draw :: CanvasElement -> Dataset -> Effect { nextDataset :: Dataset, gameover :: Boolean }
draw canvas dataset = do
  dim <- H.liftEffect $ Canvas.getCanvasDimensions canvas
  ctx <- Canvas.getContext2D canvas
  --
  Canvas.clearRect ctx { x: 0.0, y: 0.0, width: dim.width, height: dim.height }
  drawBall
  drawPaddle dim
  bricks <- pure $ coordinateBricks dataset.bricks
  drawBricks bricks
  pure $ nextDataset dataset { bricks = bricks } dim
  where
  drawBall :: Effect Unit
  drawBall = do
    ctx <- Canvas.getContext2D canvas
    --
    Canvas.beginPath ctx
    Canvas.arc ctx
      { x: dataset.x
      , y: dataset.y
      , radius: ballRadius
      , start: 0.0
      , end: Math.pi * 2.0
      }
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fill ctx
    Canvas.closePath ctx

  drawPaddle :: Dimensions -> Effect Unit
  drawPaddle { height: height } = do
    ctx <- Canvas.getContext2D canvas
    --
    Canvas.beginPath ctx
    Canvas.rect ctx
      { x: dataset.paddleX
      , y: height - paddleHeight
      , width: paddleWidth
      , height: paddleHeight
      }
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fill ctx
    Canvas.closePath ctx

  drawBricks :: Map BricksIndex Brick -> Effect Unit
  drawBricks bricks =
    for_ bricks \(Brick brick) -> do
      ctx <- Canvas.getContext2D canvas
      Canvas.beginPath ctx
      Canvas.rect ctx
        $ { x: brick.x
          , y: brick.y
          , width: Int.toNumber brickWidth
          , height: Int.toNumber brickHeight
          }
      Canvas.setFillStyle ctx "#0095DD"
      Canvas.fill ctx
      Canvas.closePath ctx

  coordinateBricks :: Map BricksIndex Brick -> Map BricksIndex Brick
  coordinateBricks bricks =
    ST.run do
      var <- STRef.new bricks
      for 0 brickColumnCount \c ->
        for 0 brickRowCount \r ->
          let
            key = BricksIndex { row: r, column: c }

            value = Brick (coord key)
          in
            STRef.modify (Map.insert key value) var
      STRef.read var
    where
    coord :: BricksIndex -> { x :: Number, y :: Number }
    coord (BricksIndex { row: r, column: c }) =
      { x: (c * (brickWidth + brickPadding)) + brickOffsetLeft # Int.toNumber
      , y: (r * (brickHeight + brickPadding)) + brickOffsetTop # Int.toNumber
      }

nextDataset :: Dataset -> Dimensions -> { nextDataset :: Dataset, gameover :: Boolean }
nextDataset dataset c =
  let
    { x: x, y: y, dx: dx, dy: dy } = dataset

    r = ballRadius

    newPaddleX = case { left: dataset.leftPressed, right: dataset.rightPressed } of
      { left: false, right: true } -> dataset.paddleX + 7.0
      { left: true, right: false } -> dataset.paddleX - 7.0
      _ -> dataset.paddleX

    { nextDy: nextDy, gameover: gameover } =
      let
        touchTheCeiling = (y + dy) < r

        touchTheFloor = (y + dy) > (c.height - r)

        touchThePaddle = touchTheFloor && between dataset.paddleX (dataset.paddleX + paddleWidth) (x + dx)
      in
        case true of
          _
            | touchTheCeiling -> { nextDy: (-dy), gameover: false }
            | touchThePaddle -> { nextDy: (-dy), gameover: false }
            | touchTheFloor -> { nextDy: (-dy), gameover: true }
            | otherwise -> { nextDy: dy, gameover: false }
  in
    { nextDataset:
        dataset
          { x = x + dx
          , y = y + dy
          , dx =
            if between r (c.width - r) (x + dx) then
              dx
            else
              (-dx)
          , dy = nextDy
          , paddleX = clamp 0.0 (c.width - paddleWidth) newPaddleX
          }
    , gameover: gameover
    }

timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
timer val = do
  { emitter, listener } <- H.liftEffect HS.create
  _ <-
    H.liftAff $ Aff.forkAff
      $ forever do
          Aff.delay $ Milliseconds 10.0
          H.liftEffect $ HS.notify listener val
  pure emitter

lesson06-2

ブロック出ました。

GitHubリポジトリ

コードはGitHub上にあります。
https://github.com/ak1211/breakout

まだつづく

よてい

Next post (2022-05-02)

MDN ブロックくずしゲームでウェブゲーム開発に入門してみた。その７

Prev post (2022-04-28)

MDN ブロックくずしゲームでウェブゲーム開発に入門してみた。その５
comments powered by Disqus