Draggable divs

draggabledivs.elm

import Html exposing (Html, Attribute)
import Html.Attributes 
import Html.Events 
import Signal exposing (Address, Message)
import List
import Json.Decode exposing (Decoder, (:=))
-------------------
--- HELPER CODE ---
-------------------
nth : Int -> List a -> Maybe a 
nth n list = 
  case List.filter (\(x, _) -> x == True)
    (List.indexedMap (\m value -> if n == m then (True, value) else (False, value)) list)
  of 
    [] -> Nothing 
    (_, x) :: _ -> Just x
    
    
    

swap : Int -> Int -> List a -> List a
swap n m list = 
  let 
      nthElement = nth n list
      mthElement = nth m list 
  in 
      case (nthElement, mthElement) of 
        (Just nx, Just mx) ->
          List.indexedMap (\index value -> 
            if | index == n -> mx
               | index == m -> nx
               | otherwise -> value
          ) list
        
        _ -> list

infixl 2 =>
(=>) = (,)

type alias Vector = { x : Float , y : Float }

boxSize : Float
boxSize = 50

margin : Float
margin = 5

type alias Layout a = 
  { a | position : Vector 
      , size     : Vector 
  }

addLayout : Layout b -> a -> Layout a
addLayout {position, size} state = 
  let 
      withPosition = 
        { state | position = position }
  in 
      { withPosition | size = size }


layoutStyles layout list =
    ("position" => "absolute")
 :: ("left" => toString layout.position.x ++ "px")
 :: ("top" => toString layout.position.y ++ "px")
 :: ("width" => toString layout.size.x ++ "px")
 :: ("height" => toString layout.size.y ++ "px")
 :: list


decoder : Decoder Vector 
decoder = 
  Json.Decode.object2 Vector
    ("pageX" := Json.Decode.float)
    ("pageY" := Json.Decode.float)
    
    
event : String -> Address a -> (Vector -> a) -> Attribute
event name address constructor = 
  Html.Events.on name decoder (constructor >> Signal.message address)
  
  
onMouseDown = event "mousedown"
onMouseUp = event "mouseup"
onMouseMove = event "mousemove"

    

---------------------------
--- INDIVIDUAL BOX CODE ---
---------------------------
type alias BoxState = 
  { color : String }



type BoxAction 
  = Press Vector
  | Move Vector
  | Release Vector
  
  
viewBox : Address BoxAction -> Layout BoxState -> Html 
viewBox address box = 
  let 
      containerStyles = 
        layoutStyles box
          [ "background-color" => box.color
          ]
  in 
      Html.div 
          [ Html.Attributes.style containerStyles  
          , onMouseDown address Press
          , onMouseUp address Release
          , onMouseMove address Move
          ]
          []
          
--------------------------
--- BOX CONTAINER CODE ---
--------------------------

type alias Selection = 
  { index : Int 
  , position : Vector 
  }
  
  
boxIsSelected : Int -> Maybe Selection -> Bool 
boxIsSelected n maybeSelection = 
  case maybeSelection of 
    Nothing -> False
    Just {index} -> 
      index == n 

type alias Container a = 
  { a | selected : Maybe Selection 
      , boxes : List BoxState 
  }
  
  
type ContainerAction 
  = Box Int BoxAction 
  | NoOpContainer
  
  
update : ContainerAction -> Container a -> Container a
update action container = 
  case action of 
    NoOpContainer -> 
      container
    
    Box n boxAction -> 
      case boxAction of 
        Press position ->
          { container | selected <- Just { index = n , position = position } }
          
        Release position ->
          case container.selected of 
            Nothing -> 
              container
              
            Just selected -> 
              { container | selected <- Nothing
                          , boxes    <- swap (findClosest position boxSize (List.length container.boxes)) selected.index container.boxes
              }
          
        Move position -> 
          case container.selected of 
            Nothing -> 
              container
              
            Just selected -> 
              { container | selected <- Just { selected | position <- position }}
          
          
findClosest : Vector -> Float -> Int -> Int
findClosest position size total = 
 let n = floor (position.x / (size + margin))
 in 
     if | n <= 0 -> 0
        | n >= total -> total
        | otherwise -> n
          

viewContainer : Address ContainerAction -> Layout (Container a) -> Html 
viewContainer address container = 
  let 
      containerStyles = 
        layoutStyles container 
          []
          
      makeBoxLayout n = 
        case container.selected of 
          Nothing -> 
            { position = 
                { x = toFloat n * (boxSize + margin)
                , y = 0
                }
            , size = 
                { x = boxSize
                , y = boxSize
                }
            }
          Just selection -> 
            if n == selection.index 
            then 
              { position = 
                { x = selection.position.x - boxSize / 2
                , y = selection.position.y - boxSize / 2
                }
              , size = 
                { x = boxSize
                , y = boxSize
                }
              }
            else 
              { position = 
                { x = toFloat n * (boxSize + margin)
                , y = 0
                }
              , size = 
                { x = boxSize
                , y = boxSize
                }
              }
              
      displayBox n boxState = 
        let boxAddress = 
              Signal.forwardTo address (Box n)
        in 
            boxState
            |> addLayout (makeBoxLayout n)
            |> viewBox boxAddress
            
            
  in 
      Html.div 
          [ Html.Attributes.style containerStyles ]
          ( List.indexedMap displayBox container.boxes )
          
          
          
----------------------
{address, signal} = Signal.mailbox NoOpContainer


initial : Layout (Container {})
initial = 
  { position = { x = 0 , y = 0 }
  , size = { x = 1000 , y = 400 }
  , selected = Nothing 
  , boxes = 
      [ { color = "blue" }
      , { color = "red"  }
      , { color = "green"}
      , { color = "blue" }
      , { color = "red"  }
      , { color = "green"}
      , { color = "blue" }
      , { color = "red"  }
      , { color = "green"}
      , { color = "blue" }
      , { color = "red"  }
      , { color = "green"}
      ]
  }
  
  
main = 
  Signal.map (viewContainer address)
    (Signal.foldp update initial signal)