ELMでドラッグ＆ドロップ

ELMでドラッグ＆ドロップを使ったアプリを作ってみた。
すっきりしたプログラムが作れる。Maybeを使えば　例外なども必要ない。
case ofでパターンマッチングも便利。覚えるコマンドも最小限で済む。
その分、うまく組み立てる必要があるが。けっこう楽しめる言語かもしれません。
module MultipleTargetsExample exposing (main) import Browser import Draggable import Draggable.Events exposing (onClick, onDragBy, onDragStart) import Html exposing (Html,button) import Html.Attributes import Math.Vector2 as Vector2 exposing (Vec2, getX, getY) import Svg exposing (..) import Svg.Attributes as Attr import Svg.Events exposing (onMouseUp) import Html.Events exposing (onClick) import Svg.Keyed import Svg.Lazy exposing (lazy) main : Program () Model Msg main = Browser.element { init = init , update = update , subscriptions = subscriptions , view = view } type alias Atom = { gensoname: String , size : String , relposition : (Float,Float) } type alias Box = { id : Id , position : Vec2 , ok : Bool , atoms: List Atom , name : String } type alias Id = String makeBox : Id -> Vec2 -> List Atom -> String -> Box makeBox id position atoms name = Box id position False atoms name dragBoxBy : Vec2 -> Box -> Box dragBoxBy delta box = { box | position = box.position |> Vector2.add delta } toggleOk : Box -> Box toggleOk box = { box | ok = True } toggleOff : Box -> Box toggleOff box = { box | ok = False } type alias BoxGroup = { uid : Int , movingBox : Maybe Box , idleBoxes : List Box } emptyGroup : BoxGroup emptyGroup = BoxGroup 0 Nothing [] addBox : (String,Vec2) -> BoxGroup -> BoxGroup addBox position ({ uid, idleBoxes } as group) = { group | idleBoxes = makeBox (String.fromInt uid) (Tuple.second position) ( case uid of 0 -> [{ gensoname = "O" , size = "50" , relposition=(0.0,0.0) },{ gensoname = "O" , size = "50" , relposition=(100.0,0.0) }] 1 -> [{ gensoname = "H" , size = "40" , relposition=(0.0,0.0) },{ gensoname = "H" , size = "40" , relposition=(80.0,0.0) } ] 2 -> [{ gensoname = "H" , size = "40" , relposition=(0.0,0.0) },{ gensoname = "H" , size = "40" , relposition=(80.0,0.0) } ] 3 -> [{ gensoname = "H" , size = "40" , relposition=(0.0,40.0) },{ gensoname = "H" , size = "40" , relposition=(150.0,40.0) } ,{ gensoname = "O" , size = "50" , relposition=(75.0,0.0)}] 4 -> [{ gensoname = "H" , size = "40" , relposition=(0.0,40.0) },{ gensoname = "H" , size = "40" , relposition=(150.0,40.0) } ,{ gensoname = "O" , size = "50" , relposition=(75.0,0.0)}] _ -> [] ) (Tuple.first position) :: idleBoxes , uid = uid + 1 } makeBoxGroup : List (String,Vec2) -> BoxGroup makeBoxGroup positions = positions |> List.foldl addBox emptyGroup allBoxes : BoxGroup -> List Box allBoxes { movingBox, idleBoxes } = movingBox |> Maybe.map (\a -> a :: idleBoxes) |> Maybe.withDefault idleBoxes startDragging : Id -> BoxGroup -> BoxGroup startDragging id ({ idleBoxes, movingBox } as group) = let ( targetAsList, others ) = List.partition (.id >> (==) id) idleBoxes in { group | idleBoxes = others , movingBox = targetAsList |> List.head } stopDragging : Id -> Wakul -> Wakul -> Wakul -> BoxGroup -> BoxGroup stopDragging id wkl1 wkl2 wkl3 group = let dfb:Box dfb=Box "" (Vector2.vec2 0.0 0.0) False [] "" mbx=group.movingBox bx=Maybe.withDefault dfb mbx -- ll= bx.name++":"++ (String.fromFloat (Vector2.getX bx.position) )++ " "++(String.fromFloat (Vector2.getY bx.position) ) xx=Vector2.getX bx.position yy=Vector2.getY bx.position in { group | idleBoxes = allBoxes group |> toggleBoxOk id wkl1 wkl2 wkl3 |> toggleBoxOff id wkl1 wkl2 wkl3 , movingBox = Nothing } dragActiveBy : Vec2 -> BoxGroup -> BoxGroup dragActiveBy delta group = { group | movingBox = group.movingBox |> Maybe.map (dragBoxBy delta) } toggleBoxOk : Id -> Wakul -> Wakul -> Wakul -> List Box -> List Box toggleBoxOk id wkl1 wkl2 wkl3 lbox = let possiblyToggleBox box = let bx=box -- ll= bx.name++":"++ (String.fromFloat (Vector2.getX bx.position) )++ " "++(String.fromFloat (Vector2.getY bx.position) ) xx=Vector2.getX bx.position yy=Vector2.getY bx.position in if bx.id == id then ( if wkl1.xss<xx && xx<wkl1.xee && wkl1.yss<yy && yy<wkl1.yee && bx.name==wkl1.nm then toggleOk bx else if wkl2.xss<xx && xx<wkl2.xee && wkl2.yss<yy && yy<wkl2.yee && bx.name==wkl2.nm then toggleOk bx else if wkl3.xss<xx && xx<wkl3.xee && wkl3.yss<yy && yy<wkl3.yee && bx.name==wkl3.nm then toggleOk bx else bx ) else bx in lbox |> List.map possiblyToggleBox toggleBoxOff : Id -> Wakul -> Wakul -> Wakul -> List Box -> List Box toggleBoxOff id wkl1 wkl2 wkl3 lbox = let possiblyToggleBox box = let bx=box -- ll= bx.name++":"++ (String.fromFloat (Vector2.getX bx.position) )++ " "++(String.fromFloat (Vector2.getY bx.position) ) xx=Vector2.getX bx.position yy=Vector2.getY bx.position in if box.id == id then ( if not (wkl1.xss<xx && xx<wkl1.xee && wkl1.yss<yy && yy<wkl1.yee && bx.name==wkl1.nm) && not (wkl2.xss<xx && xx<wkl2.xee && wkl2.yss<yy && yy<wkl2.yee && bx.name==wkl2.nm) && not (wkl3.xss<xx && xx<wkl3.xee && wkl3.yss<yy && yy<wkl3.yee && bx.name==wkl3.nm) then toggleOff bx else bx ) else bx in lbox |> List.map possiblyToggleBox type alias Model = { boxGroup : BoxGroup , drag : Draggable.State Id , notify1 : String , notify2 : String , notify3 : String , siki : Bool } type Msg = DragMsg (Draggable.Msg Id) | OnDragBy Vec2 | StartDragging String | ToggleBoxOk String | StopDragging String | Sikihyoji boxPositions : List (String,Vec2) boxPositions = let indexToPosition = ( \ii -> ( case ii of 0 -> "O2" 1 -> "H2" 2 -> "H2" 3 -> "H2O" 4 -> "H2O" _ -> "" , Vector2.vec2 ((toFloat ii)*250+60) 400)) -- toFloat >> (*) 110 >> (+) 60 >> Vector2.vec2 80 in List.range 0 4 |> List.map indexToPosition init : flags -> ( Model, Cmd Msg ) init _ = ( { boxGroup = makeBoxGroup boxPositions , drag = Draggable.init , notify1="" , notify2="" , notify3="" , siki = False } , Cmd.none ) dragConfig : Draggable.Config Id Msg dragConfig = Draggable.customConfig [ onDragBy (\( dx, dy ) -> Vector2.vec2 dx dy |> OnDragBy) , onDragStart StartDragging ] notify : Wakul -> BoxGroup -> String notify wkl boxGroup = let dfb:Box dfb=Box "" (Vector2.vec2 0.0 0.0) False [] "" mbx=boxGroup.movingBox bx=Maybe.withDefault dfb mbx -- ll= bx.name++":"++ (String.fromFloat (Vector2.getX bx.position) )++ " "++(String.fromFloat (Vector2.getY bx.position) ) xx=Vector2.getX bx.position yy=Vector2.getY bx.position in if wkl.xss<xx && xx<wkl.xee && wkl.yss<yy && yy<wkl.yee && bx.name==wkl.nm then "Ok" else "" type alias Wakul = { xss : Float , xee : Float , yss : Float , yee : Float ,nm : String } update : Msg -> Model -> ( Model, Cmd Msg ) update msg ({ boxGroup,siki} as model) = let wkl : Float -> Float -> Float -> Float -> String -> Wakul wkl x1 x2 y1 y2 st={xss=x1,xee=x2,yss=y1,yee=y2,nm=st} wkl1= wkl 41.0 257.0 54.0 338.0 "H2O" wkl2= wkl 480.0 677.0 52.0 359.0 "H2" wkl3= wkl 952.0 1110.0 52.0 349.0 "O2" in ( case msg of OnDragBy delta -> ( { model | boxGroup = boxGroup |> dragActiveBy delta }, Cmd.none ) StartDragging id -> ( { model | boxGroup = boxGroup |> startDragging id }, Cmd.none ) StopDragging id -> ( { model | notify1= boxGroup |> notify wkl1 , notify2= boxGroup |> notify wkl2 , notify3= boxGroup |> notify wkl3 , boxGroup = boxGroup |> stopDragging id wkl1 wkl2 wkl3 }, Cmd.none ) ToggleBoxOk id -> ( model , Cmd.none ) DragMsg dragMsg -> Draggable.update dragConfig dragMsg model Sikihyoji -> ( {model | siki = ( case siki of False -> True True -> False ) },Cmd.none) ) subscriptions : Model -> Sub Msg subscriptions { drag } = Draggable.subscriptions DragMsg drag -- VIEW boxSize : Vec2 boxSize = Vector2.vec2 50 50 view : Model -> Html Msg view { boxGroup,notify1,notify2,notify3,siki } = Html.div [] [ Html.p [ Html.Attributes.style "padding-left" "8px" ] [ Html.text "Drag substance . " ,Html.button [ onClick Sikihyoji ] [ text "化学反応式" ] , Html.p [ Html.Attributes.style "padding-left" "14px" , Html.Attributes.style "display" ( case siki of True -> "" False -> "none" )] [ Html.text "2H2O -> 2H2 + O2 " ]] , Svg.svg [ Attr.style "height: 100vh; width: 100vw; position: fixed;" ] [ background , boxesView boxGroup , waku boxGroup notify1 notify2 notify3 ] ] boxesView : BoxGroup -> Svg Msg boxesView boxGroup = boxGroup |> allBoxes |> List.reverse |> List.map boxView |> Svg.node "g" [] circlecreate : Vec2 -> Atom -> Svg Msg circlecreate position atom = Svg.g [] [ Svg.circle [ Attr.r atom.size , num Attr.cx (getX position +(Tuple.first atom.relposition)) , num Attr.cy (getY position +(Tuple.second atom.relposition)) , Attr.fill ( case atom.gensoname of "H" -> "blue" "O" -> "red" _ -> "white" ) , Attr.stroke "black" ] [ ] , Svg.text_ [ num Attr.x (getX position +(Tuple.first atom.relposition)-18.0) , num Attr.y (getY position +(Tuple.second atom.relposition)+14.0) , Attr.stroke "black" , Attr.fontSize "36pt" ] [Svg.text atom.gensoname] ] boxView : Box -> Svg Msg boxView { id, position, ok ,atoms} = Svg.g [ Attr.cursor "move" , Draggable.mouseTrigger id DragMsg , onMouseUp (StopDragging id) , ( case ok of True -> Attr.strokeWidth "5" _ -> Attr.strokeWidth "1" )] ( atoms |> List.map(\atom -> circlecreate position atom) ) background : Svg msg background = Svg.rect [ Attr.x "0" , Attr.y "0" , Attr.width "1300" , Attr.height "430" , Attr.fill "#eee" ] [] waku : BoxGroup -> String -> String -> String -> Svg msg waku boxGroup notify1 notify2 notify3 = Svg.g [] [ moji "50" "50" "水" ,Svg.rect [ Attr.x "0" , Attr.y "0" , Attr.width "350" , Attr.height "400" , Attr.fill "none" , Attr.stroke "black" ] [] ,moji "50" "350" notify1 , moji "380" "200" "→" , moji "500" "50" "水素" ,Svg.rect [ Attr.x "450" , Attr.y "0" , Attr.width "350" , Attr.height "400" , Attr.fill "none" , Attr.stroke "black" ] [] , moji "500" "350" notify2 , moji "820" "200" "+" , moji "950" "50" "酸素" ,Svg.rect [ Attr.x "900" , Attr.y "0" , Attr.width "350" , Attr.height "400" , Attr.fill "none" , Attr.stroke "black" ] [] ,moji "950" "350" notify3 ] moji : String -> String -> String -> Svg msg moji xs ys txt = Svg.text_ [ Attr.x xs , Attr.y ys , Attr.fill ( case txt of "Ok" -> "red" _ -> "black" ) , Attr.fontSize "36pt" ] [Svg.text txt] num : (String -> Svg.Attribute msg) -> Float -> Svg.Attribute msg num attr value = attr (String.fromFloat value)
※ただ、残念ながら、複数のターゲットをマウス操作はできるけれど、タブレット等でタッチ操作がうまくいかないようです。１つのターゲットならできるようなのだけど。
　今回は、タブレットで使いたかったので、、、ELM使用はいったん保留です。

ELMで文字入りの円をドラッグ＆ドロップするには

文字入りの円をドラッグ＆ドロップするアプリをELMで作れないか考えてみた。
ググると、Svgを使って四角をドラッグ＆ドロップする例があった。
https://package.elm-lang.org/packages/zaboco/elm-draggable/latest/
Svgライブラリの説明もあり
https://package.elm-lang.org/packages/elm/svg/latest/Svg
SVG描画で円の中心にテキストを表示する方法も参考にさせてもらいました。
ELMはエラーメッセージが詳しいので、それも助けになります。

いろいろ試行錯誤しながら　結局、ライブラリの説明の中の
g,circle,text_はList (Attribute msg) -> List (Svg msg) -> Svg msg
textがString -> Svg msg
という型の説明をもとに、組み立てるといいようでした。

一つ目のリンクのMultipleTargetsExample.elmのSvg.rectの部分を、以下のようにするとうまくいきました。

Svg.rect
        [ num Attr.width <| getX boxSize
        , num Attr.height <| getY boxSize
        , num Attr.x (getX position)
        , num Attr.y (getY position)
        , Attr.fill color
        , Attr.stroke "black"
        , Attr.cursor "move"
        , Draggable.mouseTrigger id DragMsg
        , onMouseUp StopDragging
        ]
        []
を、以下のように変更

   Svg.g
     [     Attr.cursor "move"
        , Draggable.mouseTrigger id DragMsg
        , onMouseUp StopDragging]
     [
      Svg.circle
       [
          num Attr.r <| getY boxSize
        , num Attr.cx (getX position)
        , num Attr.cy (getY position)
        , Attr.fill color
        , Attr.stroke "black"
 
       ]
       [ ]
       ,
       Svg.text_ [
         num Attr.x (getX position)
        , num Attr.y (getY position)
         ,  Attr.stroke "black"
             ]
         [Svg.text "abcde"]
     
     ]
   

   

ELMについて

ELMでフロントエンド開発はどうかと思い、試してみている。

〇まずは、設定
npmをインストールしたら

コマンドプロンプトで

npm install -g elm

npm install -g elm-format

・VS　Codeのインストール＞拡張機能 ビュー＞検索用のテキストボックスに elm ＞elm の インストール 

・日本語にするには［EXTENSIONS］ビューの一番上にある検索ボックスで「japanese」などを検索

・ファイル - 基本設定 - 設定＞右上の {} をクリック＞

ユーザー設定

{

    "elm.compiler": "C:\\Users\\win_user\\AppData\\Roaming\\npm\\elm.cmd",

    "elm.formatCommand": "C:\\Users\\win_user\\AppData\\Roaming\\npm\\elm-format.cmd",

}

〇実際に使ってみる

・ Elm のプロジェクト用のディレクトリを作成、そこでelm init を実行

　elm.json を作成するかどうか確認されるので Y を入力

・エクスプローラービューの src ディレクトリ上でElm のソースファイルを作成

・ Alt + Shift + F を入力すると module 文等が追加されます

・Ctrl + Shift + P を入力してコマンドパレット表示＞elm reactor start 

　これでWeb サーバが起動し http://localhost:8000/src/elmファイル名

　でアクセスできる

・不要であれば Elm Reactor を停止させる。コマンドパレットで elm reactor stop 

以上はhttps://qiita.com/ossan_pg/items/5c3ce00b74036139507eを参考にさせていただきました。とても詳しく説明されており助かりました。

〇elm makeについて

elm makeを使ってElmプロジェクトをビルドし、HTMLファイルなど作成できます。

elm make Main.elm --output=main.html

なお、足りないパッケージがあるとメッセージで要求されるので

elm install elm/http

elm install elm/json

のようにして、追加していく必要があります。

https://guide.elm-lang.jp/install.htmlを参考にさせていただきました。