Posted at

elmでぷよぷよ

More than 1 year has passed since last update.

elmでぷよぷよの消去アルゴリズムを書こうとしたらめんどくさかったのでメモ。

wikipedia


固定されたぷよと同色のぷよが周囲4方向にいる場合、それらは互いにくっつく。

ぷよが4個以上くっつくと消滅し得点となる。

ぷよの消滅により上にあったぷよが落下する。このとき再びぷよが4個以上くっつくと消滅し、連鎖が起きる。


とのこと。まずは下準備。

module PuyoPuyo exposing (..)

import Array exposing (Array)
import Maybe

type alias Field =
Array (Array (Maybe Color))

type alias Puyo =
Field

type alias PuyoPuyo =
{ field : Field
, puyo : Puyo
}

type Color
= Red
| Blue
| Green
| Yellow

init : PuyoPuyo
init =
{ field = Array.repeat 20 <| Array.repeat 10 Nothing
, puyo = Array.repeat 2 <| Array.repeat 2 Nothing
}

example : PuyoPuyo
example =
{ puyo = Array.repeat 2 <| Array.repeat 2 (Just Blue)
, field =
Array.fromList
[ Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Blue, Just Blue, Just Green, Just Blue, Just Green, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Just Green, Just Yellow, Just Red, Just Green, Just Green, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
]
}

setField : Int -> Int -> Maybe Color -> Field -> Maybe Field
setField y x m f =
Array.get y f
|> Maybe.andThen (\xs -> Just <| Array.set y (Array.set x m xs) f)

getField : Int -> Int -> Field -> Maybe (Maybe Color)
getField y x f =
Array.get y f
|> Maybe.andThen (\xs -> Array.get x xs)

さてメインロジック。

chainでくっついているぷよたちの座標を拾う。

chainの中で無限ループしないように辿った座標をリストで管理。

相互再帰してるのでいやらしいですね。

delete_で配列全てをchainにかけて、座標数が4つ以上だったらその座標を元にNothingに置き換える。

fall_で下から配列をなめて、Nothingとぷよを入れ替え。

落下してる様をビジュアライズしたいので落下は一マスずつ。

delete : PuyoPuyo -> PuyoPuyo

delete pp =
let
chain : List ( Int, Int ) -> ( Int, Int ) -> List ( Int, Int )
chain ls ( y, x ) =
case getField y x pp.field of
Nothing ->
ls

Just m ->
case m of
Nothing ->
ls

Just c ->
List.foldl (chain_ c)
ls
[ ( y - 1, x ), ( y, x - 1 ), ( y, x + 1 ), ( y + 1, x ) ]

chain_ : Color -> ( Int, Int ) -> List ( Int, Int ) -> List ( Int, Int )
chain_ c ( y, x ) ls =
if List.any ((==) ( y, x )) ls then
ls
else
case getField y x pp.field of
Nothing ->
ls

Just m ->
case m of
Nothing ->
ls

Just c_ ->
if c == c_ then
chain (List.append [ ( y, x ) ] ls) ( y, x )
else
ls

delete_ : Int -> Int -> Field -> Field
delete_ y x f =
if x < 10 then
if y < 20 then
delete_ y (x + 1) (delete__ y x f)
else
f
else
delete_ (y + 1) 0 (delete__ y x f)

delete__ : Int -> Int -> Field -> Field
delete__ y x f =
let
ls =
chain [] ( y, x )
in
if List.length ls >= 4 then
List.foldl delete___ f ls
else
f

delete___ : ( Int, Int ) -> Field -> Field
delete___ ( y, x ) f =
case setField y x Nothing f of
Nothing ->
f

Just f_ ->
f_

field_ =
delete_ 0 0 pp.field
in
{ pp | field = field_ }

fall : PuyoPuyo -> PuyoPuyo
fall pp =
let
fall_ y x fd =
if y > 0 then
if x < 10 then
fall_ y (x + 1) (fall__ y x fd)
else
fall_ (y - 1) 0 (fall__ y x fd)
else
fd

fall__ y x fd =
case getField y x fd of
Nothing ->
fd

Just m ->
case m of
Just _ ->
fd

Nothing ->
case getField (y - 1) x fd of
Nothing ->
fd

Just mm ->
case setField y x mm fd of
Nothing ->
fd

Just fd_ ->
case setField (y - 1) x Nothing fd_ of
Nothing ->
fd_

Just fd__ ->
fd__

field_ =
fall_ 19 0 pp.field
in
{ pp | field = field_ }

あとは適当にビジュアライズ。

タイマーにfallをセット。

落下が終わったかどうかはfallを適用する前と後のModelを比べればわかるので、落下が終わっていればdeleteを適用する。

module Main exposing (..)

import PuyoPuyo as PP
import Array
import Html as H
import Svg as S
import Svg.Attributes as SA
import Time

type alias Model =
PP.PuyoPuyo

type Msg
= Fall

main =
H.program
{ init = ( PP.example, Cmd.none )
, update = update
, view = viewField
, subscriptions = subscriptions
}

subscriptions model =
Time.every (Time.second / 5) (always Fall)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Fall ->
let
model_ =
PP.fall model
in
if model_ == model then
( PP.delete model, Cmd.none )
else
( model_, Cmd.none )

viewCircle y x m =
let
color =
case m of
Nothing ->
"black"

Just c ->
toString c
in
S.circle
[ SA.cy (toString <| (y + 1) * 25)
, SA.cx (toString <| (x + 1) * 25)
, SA.r "12"
, SA.fill color
]
[]

viewField : Model -> H.Html Msg
viewField pp =
let
ls =
List.concat <|
Array.toList <|
Array.indexedMap
(\y xs ->
Array.toList <|
Array.indexedMap (\x m -> viewCircle y x m) xs
)
pp.field
in
S.svg
[ SA.height "1100", SA.width "600" ]
ls

出来上がり。Maybeの扱いが煩わしかったです(小並感)

output.gif