在Elm中分配唯一的回调函数

我正在尝试制作一个简单的Elm Webapp,该应用程序允许我将矩形添加到SVG画布并将其拖动。但是,我在尝试以编程方式区分矩形单击处理程序时遇到问题。下面的代码对于单个矩形可以正常工作(在形状上向下移动鼠标并四处移动,它将正确拖动)。但是,每个生成的其他矩形都有其鼠标按下功能 ,它指定了第一个矩形。

这将创建具有rectID的矩形,并且(我认为)还将使用 this 矩形的rectID参数创建customOnmouseDown的 unique 局部函数。

    NewRect rectId ->
        let
            newRect =
                Rect (customOnmouseDown (String.fromInt rectId)) (String.fromInt rectId)
                    (rectId) 0 20 20
        in
            ( { model |
                    rects = newRect :: model.rects,count = model.count + 1},Cmd.none)

尝试了几种不同的公式后,我认为我对Elm运行时的思维模型是错误的,因此我不仅想知道正确的方法来做这种事情,而且想知道为什么这种方法不可行。

完整代码:

import Browser
import Browser.Events
import Html exposing (..)
import Html.Events
import Task
import Time
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Events exposing (..)
import Random
import Json.Decode as D

-- MAIN

-- main =
main =
  Browser.element
    { init = init,view = view,update = update,subscriptions = subscriptions
    }

-- MODEL


type alias Model =
    { drag : Maybe Drag,pos : Position,rects : List Rect,selected : String,count : Int
    }

type alias Position =
    { x: Int,y: Int
    }

type alias Drag =
    { startPos : Position,currentPos : Position 
    }

type alias Rect =
    { mouseDown : Html.Attribute Msg,rectId : String,x : Int,y : Int,width : Int,height : Int
    }

init : () -> (Model,Cmd Msg)
init _ =
  ( Model Nothing (Position 0 0) [] "" 0,Cmd.none
  )


-- UPDATE


type Msg
  =  Press Position String 
  | Release Position 
  | Move Position
  | AddRect
  | NewRect Int


update : Msg -> Model -> (Model,Cmd Msg)
update msg model =
  case msg of
    Press pos rectId ->
        ({model | drag = Just (Drag pos pos),selected = rectId
        },Cmd.none)

    Release pos ->
        ({ model | drag = Nothing,selected = ""},Cmd.none)

    Move pos ->
        ( { model |
                rects =
                case (getRect model.selected model.rects) of
                    Nothing -> model.rects
                    Just r ->
                        (Rect r.mouseDown r.rectId pos.x pos.y 20 20)::(dropRect r.rectId model.rects)
              },Cmd.none )

    AddRect ->
        ( model,Random.generate NewRect (Random.int 1 1000)
        )
    NewRect rectId ->
        let
            newRect =
                Rect (customOnmouseDown (String.fromInt rectId)) (String.fromInt rectId)
                    (rectId) 0 20 20
        in
            ( { model |
                    rects = newRect :: model.rects,Cmd.none)

-- SUBSCRIPTIONS

subscriptions : Model -> Sub Msg
subscriptions model =
    case model.drag of
    Nothing ->
      Sub.none

    Just _ ->
      Sub.batch [ Browser.Events.onmouseMove mouseMoveDecoder,Browser.Events.onmouseUp mouseReleaseDecoder ]

mouseMoveDecoder : D.Decoder Msg 
mouseMoveDecoder =
    D.map Move mouseCoordDecoder


mouseReleaseDecoder : D.Decoder Msg 
mouseReleaseDecoder =
    D.map Release mouseCoordDecoder


mouseCoordDecoder : D.Decoder Position 
mouseCoordDecoder =
    D.map2 Position
         (D.field "x" D.int)
         (D.field "y" D.int)

-- VIEW


view : Model -> Html Msg
view model =
  let
      total_width = "1000"
      total_height = "500"
  in 
  div []
  [ svg
    [ width total_width,height total_height,viewBox ("0 0 " ++ total_width ++ total_height)
    ]
    (renderShape  model.rects),div [] [ div [] [ Html.text (String.fromInt model.pos.x) ],div [] [ Html.text (String.fromInt model.pos.y) ],div [] [ Html.text  model.selected ],div [] [ Html.text (String.fromInt (List.length  model.rects)) ],div [] [ (renderList (List.map .rectId  model.rects)) ],button [ onClick AddRect ] [ Html.text "Rect" ] ]
  ]

renderList : List String -> Html msg
renderList lst =
    ul []
        (List.map (\l -> li [] [ Html.text l ]) lst)


customOnmouseDown : String -> (Html.Attribute Msg)
customOnmouseDown shapeIndex =
    let
        decoder = 
            D.oneOf
                [ D.map2
                      Press 
                      ( D.map2
                            Position 
                            ( D.field "pageX" D.int) 
                            ( D.field "pageY" D.int) 
                      )
                      (D.succeed ( shapeIndex )),D.succeed (Press ( Position 500 500 ) shapeIndex )
                ]  
    in
        Html.Events.on "mousedown" decoder

extractRect : Rect -> Svg Msg
extractRect r =
    rect [ r.mouseDown,x (String.fromInt r.x),y (String.fromInt r.y),width (String.fromInt r.width),height (String.fromInt r.height)
         ]
    []

renderShape : List Rect -> List (Svg Msg)
renderShape lst =
    List.map extractRect lst

rectIdMatch : String -> Rect -> Bool
rectIdMatch target rect = target == rect.rectId

getRect : String -> List Rect -> (Maybe Rect)
getRect target lst =
    List.head (List.filter (rectIdMatch target) lst)

dropRect : String -> List Rect -> List Rect
dropRect target lst =
    case lst of
        [] -> []
        [x] ->
            if x.rectId == target then
                []
            else
                []
        x::xs ->
            if x.rectId == target then
                xs
            else
                x::(dropRect target xs)
xiaomo1128 回答:在Elm中分配唯一的回调函数

每个glennsl https://ellie-app.com/76K6JmDJg4Fa1] 1

更改JSON解码器似乎可以解决该问题,尽管我不确定为什么

customOnMouseDown : String -> (Html.Attribute Msg)
customOnMouseDown shapeIndex =
    let
        decoder = 
            D.oneOf
                [ D.map2
                      Press 
                      ( D.map2
                            Position 
                            ( D.field "pageX" D.int) 
                            ( D.field "pageY" D.int) 
                      )
                      (D.succeed ( shapeIndex )),D.succeed (Press ( Position 500 500 ) shapeIndex )
                ]  
    in
        Html.Events.on "mousedown" decode
本文链接:https://www.f2er.com/3169976.html

大家都在问