Featured image of post MDN ブロックくずしゲームでウェブゲーム開発に入門してみた。その10
ブログ

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

「仕上げ」編

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

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

lesson10

1
2
3

aki:~/breakout$ cp -r lesson09/ lesson10
aki:~/breakout$ cd lesson10/
aki:~/breakout/lesson10$

lesson09 をコピーした lesson10 を用意して続きを始める。

今回は 仕上げ

プレイヤーにライフを与える

ライフを実装するのは極めて単純です。まずは他の変数を宣言したところと同じところにライフの数を保存する変数を追加しましょう。

スコアと勝ち負けのときとほぼ同じなので省略。

requestAnimationFrame()で描画を改善する

ではゲーム機構に直結しない部分、描画に関わる部分にとりかかりましょう。requestAnimationFrameは今はsetInterval()で実装している固定フレームレートよりもより良くブラウザがゲームを描画できるようにします。

1

setInterval(draw, 10);

これを簡単に次の行で置き換えます。

1

draw();

それから、draw()関数の一番下 (閉じ波括弧のすぐ前) に次の行を追加し、draw()関数が自分自身を何度も呼び出すようにします。

1

requestAnimationFrame(draw);

これでdraw()関数がrequestAnimationFrame()ループの中で何度も実行されるようになりましたが、固定の10ミリ秒のフレームレートではなくブラウザに制御を託しています。ブラウザはフレームレートを適切に同期し図形を必要なときだけ描画します。これは古いsetInterval()メソッドよりも効率的で滑らかなアニメーションループを生み出します。

requestAnimationFrameの使い方はこれを参考にした。

こうかな。

1

sid <- H.subscribe $ emitRequestAnimationFrame HandleAnimationFrame

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

emitRequestAnimationFrame :: Action -> HS.Emitter Action
emitRequestAnimationFrame val =
  HS.makeEmitter \emitter ->
    H.liftEffect do
      ref <- EffectRef.new Nothing
      let
        loop = do
          emitter val
          animationId <- Window.requestAnimationFrame loop =<< HTML.window
          EffectRef.write (Just animationId) ref
      loop
      pure do
        EffectRef.read ref >>= traverse_ \animationId -> HTML.window >>= Window.cancelAnimationFrame animationId

Bootstrapもいれておこうとおもう。

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602

module Breakout (component) where

import Prelude
import CSS (background, block, display, marginBottom, marginLeft, marginRight, marginTop, px, rgb)
import CSS.Common (auto)
import Control.Monad.ST (for)
import Control.Monad.ST as ST
import Control.Monad.ST.Ref as STRef
import Data.Array as Array
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe as Maybe
import Data.Show.Generic (genericShow)
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff.Class (class MonadAff)
import Effect.Ref as EffectRef
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.Core as HC
import Halogen.HTML.Properties as HP
import Halogen.Query.Event (eventListener)
import Halogen.Subscription as HS
import Halogen.Themes.Bootstrap4 as HB
import Math as Math
import Web.DOM.NonElementParentNode as NonElementParentNode
import Web.Event.Event as E
import Web.HTML (HTMLElement)
import Web.HTML as HTML
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.HTMLElement as HTMLElement
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
import Web.UIEvent.MouseEvent (MouseEvent)
import Web.UIEvent.MouseEvent as ME
import Web.UIEvent.MouseEvent.EventTypes as MET

canvasId = "myCanvas" :: String

paddleHeight = 10.0 :: Number

paddleWidth = 75.0 :: Number

ballRadius = 10.0 :: Number

brickRowCount = 3 :: Int

brickColumnCount = 5 :: Int

totalBricks = (brickRowCount * brickColumnCount) :: Int

brickWidth = 75 :: Int

brickHeight = 20 :: Int

brickPadding = 10 :: Int

brickOffsetTop = 30 :: Int

brickOffsetLeft = 30 :: Int

data BrickStatus
  = InActive
  | Active

derive instance genericBrickStatus :: Generic BrickStatus _

derive instance eqBrickStatus :: Eq BrickStatus

instance showBrickStatus :: Show BrickStatus where
  show = genericShow

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

derive newtype instance showBricksIndex :: Show BricksIndex

derive newtype instance eqBricksIndex :: Eq BricksIndex

derive newtype instance ordBricksIndex :: Ord BricksIndex

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

derive newtype instance showBrick :: Show Brick

type Bricks
  = Map BricksIndex Brick

newtype Score
  = Score Int

derive newtype instance showScore :: Show Score

firstScore = Score 0 :: Score

raiseToScore :: Score -> Score
raiseToScore (Score s) = Score (s + 1)

reachThePassingScore :: Score -> Boolean
reachThePassingScore (Score s) = totalBricks == s

toStringScore :: Score -> String
toStringScore (Score s) = Int.toStringAs Int.decimal s

newtype Lives
  = Lives Int

derive newtype instance showLlives :: Show Lives

firstLives = Lives 3 :: Lives

consumeLives :: Lives -> Maybe Lives
consumeLives = case _ of
  (Lives lives)
    | 1 < lives -> Just $ Lives (lives - 1)
  _ -> Nothing

toStringLives :: Lives -> String
toStringLives (Lives lives) = Int.toStringAs Int.decimal lives

type Dataset
  = { x :: Number
    , y :: Number
    , dx :: Number
    , dy :: Number
    , paddleX :: Number
    , leftPressed :: Boolean
    , rightPressed :: Boolean
    , mouseMoved :: Boolean
    , mousePointClientX :: Int
    , bricks :: Bricks
    , score :: Score
    , lives :: Lives
    }

data GameSet
  = OnGame
  | RespawnGame
  | GameOver
  | GameClear

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

data Action
  = Initialize
  | Finalize
  | HandleMouseMove MouseEvent
  | HandleAnimationFrame
  | 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
              , finalize = Just Finalize
              }
    }

initialState :: forall i. i -> State
initialState _ =
  { maybeCanvas: Nothing
  , maybeEmitAnimationFrame: Nothing
  , dataset:
      { x: 0.0
      , y: 0.0
      , dx: 0.0
      , dy: 0.0
      , paddleX: 0.0
      , leftPressed: false
      , rightPressed: false
      , mouseMoved: false
      , mousePointClientX: 0
      , bricks: Map.empty
      , score: firstScore
      , lives: firstLives
      }
  }

render :: forall m. State -> H.ComponentHTML Action () m
render state =
  HH.main
    [ HP.class_ HB.container
    ]
    [ usage
    , 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.p_ []
    , accordion
    ]
  where
  usage =
    HH.div [ HP.class_ HB.jumbotron ]
      [ HH.div [ HP.class_ HB.container ]
          [ HH.h1 [ HP.class_ HB.display4 ]
              [ HH.text "BREAKOUT GAME" ]
          , HH.p [ HP.class_ HB.lead ]
              [ HH.text "Use Arrow Keys or Mouse to play." ]
          ]
      ]

  accordion =
    HH.div
      [ HP.class_ HB.accordion
      , HP.id "accordionExample"
      ]
      [ HH.div [ HP.class_ HB.card ] [ headingOne, collapseOne ]
      , HH.div [ HP.class_ HB.card ] []
      ]

  headingOne =
    HH.div
      [ HP.classes [ HB.cardHeader, HB.p0 ]
      , HP.id "headingOne"
      ]
      [ HH.button
          [ HP.classes [ HB.btn, HB.btnLink, HB.btnBlock ]
          , HP.type_ HP.ButtonButton
          , HP.attr (HC.AttrName "data-toggle") "collapse"
          , HP.attr (HC.AttrName "data-target") "#collapseOne"
          , HP.attr (HC.AttrName "area-expanded") "true"
          , HP.attr (HC.AttrName "area-controls") "collapseOne"
          ]
          [ HH.text "いまの状態" ]
      ]

  collapseOne =
    HH.div
      [ HP.classes [ HB.collapse, HB.show ]
      , HP.id "collapseOne"
      , HP.attr (HC.AttrName "area-labelledby") "headingOne"
      , HP.attr (HC.AttrName "data-parent") "#accordionExample"
      ]
      [ HH.div [ HP.class_ HB.cardBody ] [ 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 =<< HTML.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)
    -- mouse event
    H.subscribe' \_ ->
      eventListener
        MET.mousemove
        (HTMLDocument.toEventTarget document)
        (map HandleMouseMove <<< ME.fromEvent)
    -- request animation frame
    sid <- H.subscribe $ emitRequestAnimationFrame HandleAnimationFrame
    --
    init <- H.liftEffect initialize
    H.put init { maybeEmitAnimationFrame = Just sid }
  Finalize -> pure unit
  HandleAnimationFrame -> do
    (state :: State) <- H.get
    case { a: state.maybeCanvas, b: state.maybeEmitAnimationFrame } of
      { a: Just canvas, b: Just sid } -> do
        ret <- H.liftEffect $ draw canvas state.dataset
        case ret.gameset of
          GameOver -> do
            H.liftEffect $ Window.alert "GAME OVER" =<< HTML.window
            H.unsubscribe sid
            H.liftEffect $ Location.reload =<< Window.location =<< HTML.window
          GameClear -> do
            H.liftEffect $ Window.alert "YOU WIN, CONGRATULATIONS!" =<< HTML.window
            H.unsubscribe sid
            H.liftEffect $ Location.reload =<< Window.location =<< HTML.window
          RespawnGame -> do
            respawndData <- H.liftEffect $ respawnDataset canvas ret.nextDataset
            H.modify_ \st -> st { dataset = respawndData }
          OnGame -> 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
  HandleMouseMove ev ->
    H.modify_ \st ->
      st
        { dataset
          { mouseMoved = true, mousePointClientX = ME.clientX ev }
        }
  where
  initialize :: Effect State
  initialize =
    let
      st = initialState unit
    in
      Canvas.getCanvasElementById canvasId
        >>= case _ of
            Nothing -> pure st
            Just canvas -> do
              respawnedDataset <- respawnDataset canvas st.dataset
              let
                bricks = coordinateBricks st.dataset.bricks
              pure
                $ st
                    { maybeCanvas = Just canvas
                    , dataset = respawnedDataset { bricks = bricks }
                    }

respawnDataset :: CanvasElement -> Dataset -> Effect Dataset
respawnDataset canvas ds = do
  dim <- Canvas.getCanvasDimensions canvas
  pure
    $ ds
        { x = dim.width / 2.0
        , y = dim.height - 30.0
        , dx = 2.0
        , dy = (-2.0)
        , paddleX = (dim.width - paddleWidth) / 2.0
        }

htmlElementById :: String -> Effect (Maybe HTMLElement)
htmlElementById elementId = do
  document <- Window.document =<< HTML.window
  let
    nonElementParentNode = HTMLDocument.toNonElementParentNode document
  element <- NonElementParentNode.getElementById elementId nonElementParentNode
  pure $ HTMLElement.fromElement =<< element

draw :: CanvasElement -> Dataset -> Effect { nextDataset :: Dataset, gameset :: GameSet }
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
  drawScore dim dataset.score
  drawLives dim dataset.lives
  drawBricks dataset.bricks
  offsetLeft <- canvasElementOffsetLeft canvasId
  pure $ nextDataset dataset dim offsetLeft
  where
  canvasElementOffsetLeft :: String -> Effect Number
  canvasElementOffsetLeft elemId = do
    maybeCanvasElement <- htmlElementById elemId
    maybe (pure 0.0) HTMLElement.offsetLeft $ maybeCanvasElement

  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 :: Bricks -> Effect Unit
  drawBricks =
    traverse_
      ( case _ of
          (Brick brick)
            | brick.status == Active -> 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
          _ -> pure unit
      )

  drawScore :: Dimensions -> Score -> Effect Unit
  drawScore _ score = do
    ctx <- Canvas.getContext2D canvas
    Canvas.setFont ctx "16px Arial"
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fillText ctx ("Score: " <> toStringScore score) 8.0 20.0

  drawLives :: Dimensions -> Lives -> Effect Unit
  drawLives { width: width } lives = do
    ctx <- Canvas.getContext2D canvas
    Canvas.setFont ctx "16px Arial"
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fillText ctx ("Lives: " <> toStringLives lives) (width - 65.0) 20.0

coordinateBricks :: Bricks -> Bricks
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 = coord Active key
        in
          STRef.modify (Map.insertWith modify key value) var
    STRef.read var
  where
  modify :: Brick -> Brick -> Brick
  modify (Brick current) (Brick new) = Brick new { status = current.status }

  coord :: BrickStatus -> BricksIndex -> Brick
  coord status (BricksIndex { row: r, column: c }) =
    Brick
      { x: (c * (brickWidth + brickPadding)) + brickOffsetLeft # Int.toNumber
      , y: (r * (brickHeight + brickPadding)) + brickOffsetTop # Int.toNumber
      , status: status
      }

nextDataset :: Dataset -> Dimensions -> Number -> { nextDataset :: Dataset, gameset :: GameSet }
nextDataset dataset@{ x: x, y: y, dx: dx, dy: dy } c canvasElementOffsetLeft =
  let
    { nextGameSet: nextGameSet, nextLives: nextLives } = nextGameSetAndNextLives
  in
    { nextDataset:
        dataset
          { x = x + dx
          , y = y + dy
          , dx = nextDx
          , dy = nextDy
          , paddleX = nextPaddleX
          , mouseMoved = false
          , bricks = nextBricks
          , score = nextScore
          , lives = nextLives
          }
    , gameset: nextGameSet
    }
  where
  maybeCollisionedBrick :: Maybe (Tuple BricksIndex Brick)
  maybeCollisionedBrick = collisionDetection { x: x, y: y } dataset.bricks

  updateBricks :: Tuple BricksIndex Brick -> Map BricksIndex Brick
  updateBricks (Tuple k v) = Map.insert k v dataset.bricks

  nextBricks :: Map BricksIndex Brick
  nextBricks = maybe dataset.bricks updateBricks maybeCollisionedBrick

  touchTheBrick :: Boolean
  touchTheBrick = Maybe.isJust maybeCollisionedBrick

  touchTheCeiling :: Boolean
  touchTheCeiling = (y + dy) < ballRadius

  touchTheFloor :: Boolean
  touchTheFloor = (y + dy) > (c.height - ballRadius)

  touchThePaddle :: Boolean
  touchThePaddle =
    touchTheFloor
      && between dataset.paddleX (dataset.paddleX + paddleWidth) (x + dx)

  nextScore :: Score
  nextScore = if touchTheBrick then raiseToScore dataset.score else dataset.score

  nextPaddleX :: Number
  nextPaddleX =
    let
      relativeX = Int.toNumber dataset.mousePointClientX - canvasElementOffsetLeft

      cond =
        { left: dataset.leftPressed
        , right: dataset.rightPressed
        , mouseMoved: dataset.mouseMoved
        }
    in
      clamp 0.0 (c.width - paddleWidth) case cond of
        { left: false, right: true, mouseMoved: _ } -> dataset.paddleX + 7.0
        { left: true, right: false, mouseMoved: _ } -> dataset.paddleX - 7.0
        { left: _, right: _, mouseMoved: true } -> relativeX - paddleWidth / 2.0
        _ -> dataset.paddleX

  nextDx :: Number
  nextDx =
    if between ballRadius (c.width - ballRadius) (x + dx) then
      dx
    else
      (-dx)

  nextDy :: Number
  nextDy = case true of
    _
      | touchTheCeiling -> (-dy)
      | touchThePaddle -> (-dy)
      | touchTheBrick -> (-dy)
      | otherwise -> dy

  nextGameSetAndNextLives :: { nextGameSet :: GameSet, nextLives :: Lives }
  nextGameSetAndNextLives = case true of
    _
      | reachThePassingScore nextScore -> { nextGameSet: GameClear, nextLives: dataset.lives }
      | touchTheFloor && (not touchThePaddle) -> case consumeLives dataset.lives of
        Just l -> { nextGameSet: RespawnGame, nextLives: l }
        Nothing -> { nextGameSet: GameOver, nextLives: dataset.lives }
      | otherwise -> { nextGameSet: OnGame, nextLives: dataset.lives }

collisionDetection :: { x :: Number, y :: Number } -> Bricks -> Maybe (Tuple BricksIndex Brick)
collisionDetection ball bricks =
  inactivate
    <$> ( Array.head
          $ Map.toUnfoldableUnordered
          $ Map.filterWithKey collidesBallAndBrick bricks
      )
  where
  inactivate :: Tuple BricksIndex Brick -> Tuple BricksIndex Brick
  inactivate (Tuple idx (Brick brick)) = Tuple idx $ Brick brick { status = InActive }

  collidesBallAndBrick :: BricksIndex -> Brick -> Boolean
  collidesBallAndBrick _ (Brick brick) = case brick.status of
    InActive -> false
    Active
      | between brick.x (brick.x + (Int.toNumber brickWidth)) ball.x
          && between brick.y (brick.y + (Int.toNumber brickHeight)) ball.y -> true
      | otherwise -> false

emitRequestAnimationFrame :: Action -> HS.Emitter Action
emitRequestAnimationFrame val =
  HS.makeEmitter \emitter ->
    H.liftEffect do
      ref <- EffectRef.new Nothing
      let
        loop = do
          emitter val
          animationId <- Window.requestAnimationFrame loop =<< HTML.window
          EffectRef.write (Just animationId) ref
      loop
      pure do
        EffectRef.read ref >>= traverse_ \animationId -> HTML.window >>= Window.cancelAnimationFrame animationId

lesson10-1

自分のコードを比べる

これで全部です。ゲームの最終版が準備でき、プレイできる状態になりました。 調整した。 BootstrapのためにFFIしなければならなくなった。

1
2
3
4
5
6
7
8
9

"use strict";

exports.showModalDialogImpl = function (target) {
	$('#' + target).modal('show')
};

exports.hideModalDialogImpl = function (target) {
	$('#' + target).modal('hide')
};

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670

module Breakout
  ( component
  ) where

import Prelude
import CSS (background, block, display, rgb)
import Control.Monad.ST (for)
import Control.Monad.ST as ST
import Control.Monad.ST.Ref as STRef
import Data.Array as Array
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe as Maybe
import Data.Show.Generic (genericShow)
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff.Class (class MonadAff)
import Effect.Ref as EffectRef
import Effect.Uncurried (EffectFn1, runEffectFn1)
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.Core as HC
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.Event (eventListener)
import Halogen.Subscription as HS
import Halogen.Themes.Bootstrap4 as HB
import Math as Math
import Web.DOM.NonElementParentNode as NonElementParentNode
import Web.Event.Event as E
import Web.HTML (HTMLElement)
import Web.HTML as HTML
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.HTMLElement as HTMLElement
import Web.HTML.Window as Window
import Web.UIEvent.KeyboardEvent as KE
import Web.UIEvent.KeyboardEvent.EventTypes as KET
import Web.UIEvent.MouseEvent (MouseEvent)
import Web.UIEvent.MouseEvent as ME
import Web.UIEvent.MouseEvent.EventTypes as MET

type ModalDialogInfo
  = { modalId :: String
    , title :: String
    , message :: String
    }

foreign import showModalDialogImpl :: EffectFn1 String Unit

foreign import hideModalDialogImpl :: EffectFn1 String Unit

showModalDialog :: String -> Effect Unit
showModalDialog = runEffectFn1 showModalDialogImpl

hideModalDialog :: String -> Effect Unit
hideModalDialog = runEffectFn1 hideModalDialogImpl

data BrickStatus
  = InActive
  | Active

derive instance genericBrickStatus :: Generic BrickStatus _

derive instance eqBrickStatus :: Eq BrickStatus

instance showBrickStatus :: Show BrickStatus where
  show = genericShow

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

derive newtype instance showBricksIndex :: Show BricksIndex

derive newtype instance eqBricksIndex :: Eq BricksIndex

derive newtype instance ordBricksIndex :: Ord BricksIndex

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

derive newtype instance showBrick :: Show Brick

type Bricks
  = Map BricksIndex Brick

newtype Score
  = Score Int

derive newtype instance showScore :: Show Score

raiseToScore :: Score -> Score
raiseToScore (Score s) = Score (s + 1)

reachThePassingScore :: Score -> Boolean
reachThePassingScore (Score s) = totalBricks == s

toStringScore :: Score -> String
toStringScore (Score s) = Int.toStringAs Int.decimal s

newtype Lives
  = Lives Int

derive newtype instance showLives :: Show Lives

consumeLives :: Lives -> Maybe Lives
consumeLives = case _ of
  (Lives lives)
    | 1 < lives -> Just $ Lives (lives - 1)
  _ -> Nothing

toStringLives :: Lives -> String
toStringLives (Lives lives) = Int.toStringAs Int.decimal lives

canvasId = "myCanvas" :: String

paddleHeight = 10.0 :: Number

paddleWidth = 75.0 :: Number

ballRadius = 10.0 :: Number

brickRowCount = 3 :: Int

brickColumnCount = 5 :: Int

totalBricks = (brickRowCount * brickColumnCount) :: Int

brickWidth = 75 :: Int

brickHeight = 20 :: Int

brickPadding = 10 :: Int

brickOffsetTop = 30 :: Int

brickOffsetLeft = 30 :: Int

firstScore = Score 0 :: Score

firstLives = Lives 3 :: Lives

type Dataset
  = { x :: Number
    , y :: Number
    , dx :: Number
    , dy :: Number
    , paddleX :: Number
    , leftPressed :: Boolean
    , rightPressed :: Boolean
    , mouseMoved :: Boolean
    , mousePointClientX :: Int
    , bricks :: Bricks
    , score :: Score
    , lives :: Lives
    }

data GameSet
  = OnGame
  | RespawnGame
  | GameOver
  | GameClear

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

data Action
  = Initialize
  | Finalize
  | HandleMouseMove MouseEvent
  | HandleAnimationFrame
  | HandleKeyDown KE.KeyboardEvent
  | HandleKeyUp KE.KeyboardEvent
  | HandleDialogCloseButton ModalDialogInfo

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
              , finalize = Just Finalize
              }
    }

initialState :: forall i. i -> State
initialState _ =
  { maybeCanvas: Nothing
  , maybeEmitAnimationFrame: Nothing
  , dataset:
      { x: 0.0
      , y: 0.0
      , dx: 0.0
      , dy: 0.0
      , paddleX: 0.0
      , leftPressed: false
      , rightPressed: false
      , mouseMoved: false
      , mousePointClientX: 0
      , bricks: Map.empty
      , score: firstScore
      , lives: firstLives
      }
  }

gameClearDialog :: ModalDialogInfo
gameClearDialog =
  { modalId: "gameClearDialog"
  , title: "GAME CLEAR"
  , message: "YOU WIN, CONGRATULATIONS!"
  }

gameOverDialog :: ModalDialogInfo
gameOverDialog =
  { modalId: "gameOverDialog"
  , title: "GAME OVER"
  , message: "YOU LOSE"
  }

render :: forall m. State -> H.ComponentHTML Action () m
render state =
  HH.main [ HP.class_ HB.container ]
    [ modalDialog gameClearDialog
    , modalDialog gameOverDialog
    , HH.div [ HP.class_ HB.row ] [ greeting ]
    , HH.div [ HP.class_ HB.row ] [ accordion ]
    , HH.div [ HP.classes [ HB.row, HB.justifyContentCenter ] ]
        [ HH.canvas
            [ HP.classes [ HB.m3, HB.border, HB.borderInfo ]
            , style do
                background (rgb 238 238 238)
                display block
            , HP.id canvasId
            , HP.width 480
            , HP.height 320
            ]
        ]
    ]
  where
  greeting =
    HH.div [ HP.class_ HB.col ]
      [ HH.h1 [ HP.classes [ HB.display4, HB.textCenter ] ] [ HH.text "BREAKOUT" ]
      , HH.hr [ HP.class_ HB.my4 ]
      , HH.p [ HP.class_ HB.lead ] [ HH.text "Use Arrow Keys or Mouse to play." ]
      ]

  accordion =
    HH.div
      [ HP.classes [ HB.col, HB.accordion ]
      , HP.id "accordionExample"
      ]
      [ HH.div [ HP.class_ HB.card ] [ headingOne, collapseOne ]
      , HH.div [ HP.class_ HB.card ] []
      ]

  headingOne =
    HH.div
      [ HP.classes [ HB.cardHeader, HB.p0 ]
      , HP.id "headingOne"
      ]
      [ HH.button
          [ HP.classes [ HB.btn, HB.btnOutlineInfo, HB.btnBlock ]
          , HP.type_ HP.ButtonButton
          , HP.attr (HC.AttrName "data-toggle") "collapse"
          , HP.attr (HC.AttrName "data-target") "#collapseOne"
          , HP.attr (HC.AttrName "area-controls") "collapseOne"
          ]
          [ HH.text "いまの状態" ]
      ]

  collapseOne =
    HH.div
      [ HP.classes [ HB.collapse ]
      , HP.id "collapseOne"
      , HP.attr (HC.AttrName "area-labelledby") "headingOne"
      , HP.attr (HC.AttrName "data-parent") "#accordionExample"
      , HP.attr (HC.AttrName "area-expanded") "false"
      ]
      [ HH.div [ HP.class_ HB.cardBody ] [ HH.text $ show state.dataset ]
      ]

modalDialog :: forall m. ModalDialogInfo -> H.ComponentHTML Action () m
modalDialog input =
  HH.div
    [ HP.classes [ HB.modal, HB.fade, HB.show ]
    , HP.id input.modalId
    , HP.tabIndex (-1)
    , HP.attr (HC.AttrName "role") "dialog"
    , HP.attr (HC.AttrName "data-backdrop") "static"
    , HE.onKeyDown \_ -> (HandleDialogCloseButton input)
    ]
    [ HH.div
        [ HP.classes [ HB.modalDialog, HB.modalDialogCentered ]
        , HP.attr (HC.AttrName "role") "document"
        ]
        [ HH.div [ HP.class_ HB.modalContent ]
            [ HH.div [ HP.class_ HB.modalHeader ]
                [ HH.h5 [ HP.class_ HB.modalTitle ] [ HH.text input.title ]
                , HH.button
                    [ HP.class_ HB.close
                    , HP.type_ HP.ButtonButton
                    , HP.attr (HC.AttrName "data-dismiss") "modal"
                    , HP.attr (HC.AttrName "area-label") "Close"
                    , HE.onClick \_ -> (HandleDialogCloseButton input)
                    ]
                    [ HH.span [ HP.attr (HC.AttrName "area-hidden") "true" ] [ HH.text "×" ] ]
                ]
            , HH.div [ HP.class_ HB.modalBody ] [ HH.p_ [ HH.text input.message ] ]
            , HH.div [ HP.class_ HB.modalFooter ]
                [ HH.button
                    [ HP.classes [ HB.btn, HB.btnPrimary ]
                    , HP.type_ HP.ButtonButton
                    , HP.attr (HC.AttrName "data-dismiss") "modal"
                    , HE.onClick \_ -> (HandleDialogCloseButton input)
                    ]
                    [ HH.text "Close" ]
                ]
            ]
        ]
    ]

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 =<< HTML.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)
    -- mouse event
    H.subscribe' \_ ->
      eventListener
        MET.mousemove
        (HTMLDocument.toEventTarget document)
        (map HandleMouseMove <<< ME.fromEvent)
    -- request animation frame
    sid <- H.subscribe $ emitRequestAnimationFrame HandleAnimationFrame
    --
    init <- H.liftEffect initialize
    H.put init { maybeEmitAnimationFrame = Just sid }
  Finalize -> do
    (state :: State) <- H.get
    maybe mempty H.unsubscribe state.maybeEmitAnimationFrame
  HandleAnimationFrame -> do
    (state :: State) <- H.get
    case state.maybeCanvas of
      Just canvas -> do
        ret <- H.liftEffect $ draw canvas state.dataset
        case ret.gameset of
          GameOver -> H.liftEffect $ showModalDialog gameOverDialog.modalId
          GameClear -> H.liftEffect $ showModalDialog gameClearDialog.modalId
          RespawnGame -> do
            respawndData <- H.liftEffect $ respawnDataset canvas ret.nextDataset
            H.modify_ \st -> st { dataset = respawndData }
          OnGame -> 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
  HandleMouseMove ev ->
    H.modify_ \st ->
      st
        { dataset
          { mouseMoved = true, mousePointClientX = ME.clientX ev }
        }
  HandleDialogCloseButton info -> do
    H.liftEffect $ hideModalDialog info.modalId
    init <- H.liftEffect initialize
    H.put init
  where
  initialize :: Effect State
  initialize =
    let
      st = initialState unit
    in
      Canvas.getCanvasElementById canvasId
        >>= case _ of
            Nothing -> pure st
            Just canvas -> do
              respawnedDataset <- respawnDataset canvas st.dataset
              let
                bricks = coordinateBricks st.dataset.bricks
              pure
                $ st
                    { maybeCanvas = Just canvas
                    , dataset = respawnedDataset { bricks = bricks }
                    }

respawnDataset :: CanvasElement -> Dataset -> Effect Dataset
respawnDataset canvas ds = do
  dim <- Canvas.getCanvasDimensions canvas
  pure
    $ ds
        { x = dim.width / 2.0
        , y = dim.height - 30.0
        , dx = 2.0
        , dy = (-2.0)
        , paddleX = (dim.width - paddleWidth) / 2.0
        }

htmlElementById :: String -> Effect (Maybe HTMLElement)
htmlElementById elementId = do
  document <- Window.document =<< HTML.window
  let
    nonElementParentNode = HTMLDocument.toNonElementParentNode document
  element <- NonElementParentNode.getElementById elementId nonElementParentNode
  pure $ HTMLElement.fromElement =<< element

draw :: CanvasElement -> Dataset -> Effect { nextDataset :: Dataset, gameset :: GameSet }
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
  drawScore dim dataset.score
  drawLives dim dataset.lives
  drawBricks dataset.bricks
  offsetLeft <- canvasElementOffsetLeft canvasId
  pure $ nextDataset dataset dim offsetLeft
  where
  canvasElementOffsetLeft :: String -> Effect Number
  canvasElementOffsetLeft elemId = do
    maybeCanvasElement <- htmlElementById elemId
    maybe (pure 0.0) HTMLElement.offsetLeft $ maybeCanvasElement

  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 :: Bricks -> Effect Unit
  drawBricks =
    traverse_
      ( case _ of
          (Brick brick)
            | brick.status == Active -> 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
          _ -> pure unit
      )

  drawScore :: Dimensions -> Score -> Effect Unit
  drawScore _ score = do
    ctx <- Canvas.getContext2D canvas
    Canvas.setFont ctx "16px Arial"
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fillText ctx ("Score: " <> toStringScore score) 8.0 20.0

  drawLives :: Dimensions -> Lives -> Effect Unit
  drawLives { width: width } lives = do
    ctx <- Canvas.getContext2D canvas
    Canvas.setFont ctx "16px Arial"
    Canvas.setFillStyle ctx "#0095DD"
    Canvas.fillText ctx ("Lives: " <> toStringLives lives) (width - 65.0) 20.0

coordinateBricks :: Bricks -> Bricks
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 = coord Active key
        in
          STRef.modify (Map.insertWith modify key value) var
    STRef.read var
  where
  modify :: Brick -> Brick -> Brick
  modify (Brick current) (Brick new) = Brick new { status = current.status }

  coord :: BrickStatus -> BricksIndex -> Brick
  coord status (BricksIndex { row: r, column: c }) =
    Brick
      { x: (c * (brickWidth + brickPadding)) + brickOffsetLeft # Int.toNumber
      , y: (r * (brickHeight + brickPadding)) + brickOffsetTop # Int.toNumber
      , status: status
      }

nextDataset :: Dataset -> Dimensions -> Number -> { nextDataset :: Dataset, gameset :: GameSet }
nextDataset dataset@{ x: x, y: y, dx: dx, dy: dy } c canvasElementOffsetLeft =
  let
    { nextGameSet: nextGameSet, nextLives: nextLives } = nextGameSetAndNextLives
  in
    { nextDataset:
        dataset
          { x = x + dx
          , y = y + dy
          , dx = nextDx
          , dy = nextDy
          , paddleX = nextPaddleX
          , mouseMoved = false
          , bricks = nextBricks
          , score = nextScore
          , lives = nextLives
          }
    , gameset: nextGameSet
    }
  where
  maybeCollisionedBrick :: Maybe (Tuple BricksIndex Brick)
  maybeCollisionedBrick = collisionDetection { x: x, y: y } dataset.bricks

  updateBricks :: Tuple BricksIndex Brick -> Map BricksIndex Brick
  updateBricks (Tuple k v) = Map.insert k v dataset.bricks

  nextBricks :: Map BricksIndex Brick
  nextBricks = maybe dataset.bricks updateBricks maybeCollisionedBrick

  hitBrick :: Boolean
  hitBrick = Maybe.isJust maybeCollisionedBrick

  hitCeiling :: Boolean
  hitCeiling = (y + dy) < ballRadius

  hitFloor :: Boolean
  hitFloor = (y + dy) > (c.height - ballRadius)

  hitLeftWall :: Boolean
  hitLeftWall = (x + dx) < ballRadius

  hitRightWall :: Boolean
  hitRightWall = (x + dx) > (c.width - ballRadius)

  hitPaddle :: Boolean
  hitPaddle = hitFloor && between dataset.paddleX (dataset.paddleX + paddleWidth) (x + dx)

  nextScore :: Score
  nextScore = if hitBrick then raiseToScore dataset.score else dataset.score

  nextPaddleX :: Number
  nextPaddleX =
    let
      relativeX = Int.toNumber dataset.mousePointClientX - canvasElementOffsetLeft

      cond =
        { left: dataset.leftPressed
        , right: dataset.rightPressed
        , mouseMoved: dataset.mouseMoved
        }
    in
      clamp 0.0 (c.width - paddleWidth) case cond of
        { left: false, right: true, mouseMoved: _ } -> dataset.paddleX + 7.0
        { left: true, right: false, mouseMoved: _ } -> dataset.paddleX - 7.0
        { left: _, right: _, mouseMoved: true } -> relativeX - paddleWidth / 2.0
        _ -> dataset.paddleX

  nextDx :: Number
  nextDx = if hitLeftWall || hitRightWall then (-dx) else dx

  nextDy :: Number
  nextDy = case true of
    _
      | hitCeiling -> (-dy)
      | hitPaddle -> (-dy)
      | hitBrick -> (-dy)
      | otherwise -> dy

  nextGameSetAndNextLives :: { nextGameSet :: GameSet, nextLives :: Lives }
  nextGameSetAndNextLives = case true of
    _
      | reachThePassingScore nextScore -> { nextGameSet: GameClear, nextLives: dataset.lives }
      | hitFloor && (not hitPaddle) -> case consumeLives dataset.lives of
        Just l -> { nextGameSet: RespawnGame, nextLives: l }
        Nothing -> { nextGameSet: GameOver, nextLives: dataset.lives }
      | otherwise -> { nextGameSet: OnGame, nextLives: dataset.lives }

collisionDetection :: { x :: Number, y :: Number } -> Bricks -> Maybe (Tuple BricksIndex Brick)
collisionDetection ball bricks =
  inactivate
    <$> ( Array.head
          $ Map.toUnfoldableUnordered
          $ Map.filterWithKey collidesBallAndBrick bricks
      )
  where
  inactivate :: Tuple BricksIndex Brick -> Tuple BricksIndex Brick
  inactivate (Tuple idx (Brick brick)) = Tuple idx $ Brick brick { status = InActive }

  collidesBallAndBrick :: BricksIndex -> Brick -> Boolean
  collidesBallAndBrick _ (Brick brick) = case brick.status of
    InActive -> false
    Active
      | between brick.x (brick.x + (Int.toNumber brickWidth)) ball.x
          && between brick.y (brick.y + (Int.toNumber brickHeight)) ball.y -> true
      | otherwise -> false

emitRequestAnimationFrame :: Action -> HS.Emitter Action
emitRequestAnimationFrame val =
  HS.makeEmitter \emitter ->
    H.liftEffect do
      ref <- EffectRef.new Nothing
      let
        loop = do
          emitter val
          animationId <- Window.requestAnimationFrame loop =<< HTML.window
          EffectRef.write (Just animationId) ref
      loop
      pure do
        EffectRef.read ref >>= traverse_ \animationId -> HTML.window >>= Window.cancelAnimationFrame animationId

670行。なげーな。 lesson10-2

GitHubリポジトリ

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

それぞれのフォルダにあるindex.htmlをブラウザで開いてプレイする。

breakout-game

おわり

これで終わり。あきたので。

comments powered by Disqus
© 2015 - 2023 Akihiro Yamamoto

This website uses cookies to improve your experience.
このサイトは「Googleアナリティクス」を使用しています。
Googleアナリティクスはデータの収集のためにCookieを使用しています。


Built with Hugo
テーマ Stack は Jimmy によって設計されています。