LoginSignup
20
7

More than 5 years have passed since last update.

@kmtoki

elmでぷよぷよ

Posted at

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

20
7
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
20
7