Edit affine transformations with mouse and keyboard in Elm

affine_edit.elm

import Color exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)
import Mouse
import Keyboard
import Char
import Signal
import Transform2D
import Time

main : Signal Element
main = Signal.map (\affine ->
  collage 800 800
  [groupTransform affine
    [ move (0, 0) box
    , move (0, 40) box
    , move (0, 80) box
    , move (40, 0) box
    , move (40, 40) box
    , move (40, 80) box
    , move (80, 0) box
    , move (80, 40) box
    , move (80, 80) box
    , move (60, 40) (filled red (ngon 3 40))
    , move (20, 40) (filled blue (ngon 3 40))
    ]
   , move (0, 280) (scale 0.75 (toForm (show affine)))
   ]) affineSignal

box = outlined (solid black) (square 40)

sampleOnRelease : Char -> Signal a -> Signal a
sampleOnRelease chr = Signal.sampleOn (Signal.filter not True (Keyboard.isDown (Char.toCode chr)))

sampleOnPress : Char -> Signal a -> Signal a
sampleOnPress chr = Signal.sampleOn (Signal.filter identity False (Keyboard.isDown (Char.toCode chr)))

sampleOnPressed : Char -> Signal a -> Signal a
sampleOnPressed chr = Signal.sampleOn (Time.fpsWhen 30 (Keyboard.isDown (Char.toCode chr)))

type MouseKeyDrag = MouseKeyDrag Char Bool (Int, Int) (Int, Int)
mouseKeyDrag chr = Signal.map3 (MouseKeyDrag chr)
 (Keyboard.isDown (Char.toCode chr))
 (sampleOnPress chr Mouse.position)
 (sampleOnPressed chr Mouse.position)

controls : Signal MouseKeyDrag
controls = Signal.mergeMany [ mouseKeyDrag 'T'
                            , mouseKeyDrag 'S'
                            , mouseKeyDrag 'R'
                            , mouseKeyDrag 'K'
                            ]

type alias State = (Transform2D.Transform2D, Transform2D.Transform2D)
initialState : State
initialState = (Transform2D.identity, Transform2D.identity)

currentState : Signal State
currentState = Signal.foldp updateState initialState controls

updateState : MouseKeyDrag -> State -> State
updateState (MouseKeyDrag char pressed (x1, y1) (x2, y2)) (sa, sb) =
 let
  xd = toFloat (x2 - x1)
  yd = toFloat (y2 - y1)
  translation = Transform2D.translation (toFloat (x2-x1)) (toFloat -(y2-y1))
  scale = Transform2D.matrix ((xd / 100) + 1) 0 0 (-(yd / 100) + 1) 0 0
  theta = snd (toPolar (xd, yd))
  rotation = Transform2D.rotation -theta
  skew = Transform2D.matrix 1 (xd / 100) 0 1 0 0
 in
 case (char, pressed) of
  ('T', True) -> (sa, translation)
  ('T', False) -> (sa `Transform2D.multiply` translation, Transform2D.identity)
  ('S', True) -> (sa, scale)
  ('S', False) -> (sa `Transform2D.multiply` scale, Transform2D.identity)
  ('R', True) -> (sa, rotation)
  ('R', False) -> (sa `Transform2D.multiply` rotation, Transform2D.identity)
  ('K', True) -> (sa, skew)
  ('K', False) -> (sa `Transform2D.multiply` skew, Transform2D.identity)
  _ -> (sa, sb)

affineSignal = Signal.map (uncurry Transform2D.multiply) currentState