badimagecrop.elm

import Html exposing (Html, Attribute, div, img, input)
import Html.Attributes exposing (style, src, width, height, type')
import Html.Events
import Json.Decode as Json exposing (Decoder, (:=))

import Signal exposing (Address)
import StartApp
import String

import Debug

type alias Vector = 
  { x : Float
  , y : Float
  }
  
  
translate {x, y} = 
  "translate3d(" ++ toString x ++ "px, " ++ toString y ++ "px, 0px)"

scale s = 
  "scale(" ++ toString s ++ ")"
  
infixl 2 =>  
(=>) = (,)


type alias State = 
  { source : String
  , offset : Vector
  , size   : Vector
  , zoom   : Float
  , currentPress : Maybe Vector
  }
  
 
initial : State 
initial = 
  { source = "http://d1oi7t5trwfj5d.cloudfront.net/91/a9/5a2c1503496da25094b88e9eda5f/avatar.jpeg"
  , offset = Vector 0 0
  , size   = Vector 128 128
  , zoom   = 1
  , currentPress = Nothing
  }
  
type Action 
  = SetZoom String
  | Press Vector
  | Move Vector
  | Release Vector
  
  

update : Action -> State -> State
update action state = 
  case action of 
    SetZoom zoom -> 
      case String.toFloat zoom of 
        Ok z -> 
          { state | zoom <- z }
          
        _ ->
          state
          
    Press position -> 
      { state | currentPress <- Just position }
      
    Move position -> 
      case state.currentPress of 
        Nothing ->
          state 
          
        Just curPos -> 
          let 
              newOffset = 
                { x = (position.x - curPos.x)
                , y = (position.y - curPos.y)
                }
          in 
              { state | offset <- newOffset }
              
    Release position ->
      case state.currentPress of 
        Nothing ->
          state 
          
        Just curPos ->
          let 
              newOffset = 
                { x = (position.x - curPos.x)
                , y = (position.y - curPos.y)
                }
          in 
              { state | offset <- newOffset
                      , currentPress <- Nothing 
              }
  
  
targetValue = 
  --Json.customDecoder Html.Events.targetValue String.toFloat
  Json.at ["target", "value" ] Json.string
  
--onInput : Address a -> (Float -> a) -> Attribute  
onInput address constructor = 
  Html.Events.on
    "input"
    targetValue 
    (constructor >> Signal.message address)
  
  
currentPosition = 
  Json.object2 Vector
    ("pageX" := Json.float)
    ("pageY" := Json.float)
    
onMouseDown address constructor = 
  Html.Events.on
    "mousedown"
    currentPosition 
    (constructor >> Signal.message address)  
    
onMouseMove address constructor = 
  Html.Events.on
    "mousemove"
    currentPosition 
    (constructor >> Signal.message address)  
    
onMouseUp address constructor = 
  Html.Events.on
    "mouseup"
    currentPosition 
    (constructor >> Signal.message address)  


onMouseOut address constructor = 
  Html.Events.on
    "mouseout"
    currentPosition 
    (constructor >> Signal.message address)
    
onMouseLeave address constructor = 
  Html.Events.on
    "mouseleave"
    currentPosition 
    (constructor >> Signal.message address)
  
view : Address Action -> State -> Html
view address state = 
  let 
      frameBorder = 
        20
        
      outerSize = 
        { x = state.size.x + 2 * frameBorder
        , y = state.size.y + 2 * frameBorder
        }
  
      outerFrameStyle = 
        [ "transform" => translate (Vector 100 100)
        , "width"  => toString outerSize.x ++ "px"
        , "height" => toString outerSize.y ++ "px"
        , "overflow" => "hidden"
        , "background-color" => "black"
        , "filter" => "blur"
        ]
        
      innerFrameStyle = 
        [ "position" => "absolute"
        , "left"   => toString frameBorder ++ "px"
        , "top"    => toString frameBorder ++ "px"
        , "width"  => toString state.size.x ++ "px"
        , "height" => toString state.size.y ++ "px"
        , "background-color" => "transparent"
        
        ]
        
      imageStyle = 
        [ "position"  => "absolute"
        , "width"  => toString outerSize.x ++ "px"
        , "height" => toString outerSize.y ++ "px"
        , "transform" => translate state.offset  ++ scale state.zoom
        , "-webkit-user-drag" => "none"
        ]
        
      containerStyle = 
        [ "display" => "flex" ]
        
      inputStyle =
        [ "z-index" => "1" ]
        
  in 
      div 
        [ style containerStyle ]
        [ div 
            [ style outerFrameStyle 
            , onMouseDown address Press
            , onMouseMove address Move
            , onMouseUp address Release
            , onMouseOut address Release
            , onMouseLeave address Release
            ]
            [ div 
                [ style innerFrameStyle ]
                []
            , img 
                [ style imageStyle
                , src state.source
                , width 1040
                , height 650
                ]
                []
            ]
        , input
            [ type' "range"
            , Html.Attributes.min "1"
            , Html.Attributes.max "10"
            , Html.Attributes.step "1"
            , Html.Attributes.value (toString state.zoom)
            , onInput address SetZoom
            , style inputStyle
            ]
            []
        ]
      
  
main = 
  StartApp.start
    { model  = initial
    , view   = view
    , update = update
    }