Skip to content

Instantly share code, notes, and snippets.

@shepelevstas

shepelevstas/Main.elm

Last active July 19, 2022 12:45
Show Gist options
  • Save shepelevstas/bfd89703354819309fbb7f59dfcb2ddb to your computer and use it in GitHub Desktop.
Save shepelevstas/bfd89703354819309fbb7f59dfcb2ddb to your computer and use it in GitHub Desktop.
Download ZIP
Kadr widget
Raw
index.html
<html>
<head>
<style>
.pos-fixed, .fixed {position: fixed;}
.rel {position: relative;}
.abs {position: absolute;}
.of-hidden {overflow: hidden;}
.bg-gainsboro {background-color: gainsboro;}
.bg-white {background-color: white;}
.bg-gray {background-color: gray;}
.bg-lightgreen {background-color: lightgreen;}
.outline-gray {outline: 1px solid gray;}
.outline-lightgray {outline: 1px solid lightgray;}
.sides-0 {top:0;left:0;right:0;bottom:0;}
.d-flex {display:flex;}
.cur-move {cursor: move;}
.trans--50 {transform: translate(-50%, -50%);}
</style>
</head>
<body style="padding:0;">
<main></main>
<script>
var app = Elm.Main.init({ node: document.querySelector('main') })
// you can use ports and stuff here
document.body.onkeydown = function(e){if(e.altKey||e.ctrlKey){return false}else{console.log('key.code',e)}}
</script>
</body>
</html>
Raw
Main.elm
module Main exposing (main)
import Browser
import Browser.Events as Events
import Browser.Dom as Dom
import Html exposing (Html, button, div, text)
import Html.Attributes exposing (class, style, id)
import Html.Events exposing (onClick)
import Html.Events.Extra.Mouse as Mouse
import Json.Decode as D
import Task
type alias Model =
{ count : Int
, x : Float
, y : Float
, w : Float
, h : Float
, drag : Bool
, pos : ( Float, Float )
, width_ratio : Float
, dragMode : DragMode
}
type DragMode = DragModeNone | DragModeMove | DragModeSize
initialModel : Model
initialModel =
{ count = 0
, x = 70
, y = 70
, w = 250
, h = 300
, drag = False
, pos = ( 0, 0 )
, width_ratio = 0
, dragMode = DragModeNone
}
init : () -> ( Model, Cmd Msg )
init _ =
( initialModel
, Cmd.none
)
type Msg
= Increment
| Decrement
| DragMove Bool ( Float, Float )
| DragStop Float
| DragStart ( Float, Float )
| GotPos (Result Dom.Error Dom.Element)
| DragStartSize (Float, Float)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Increment ->
( { model | count = model.count + 1 }, Cmd.none )
Decrement ->
( { model | count = model.count - 1 }, Cmd.none )
DragStartSize mouse_pos ->
( { model
| drag=True
, pos = mouse_pos
, dragMode = DragModeSize
}
, Task.attempt GotPos (Dom.getElement "ctrl_pos")
)
DragStart pos ->
( { model | drag = True, pos = pos }
, Cmd.none )
GotPos res ->
case res of
Err err -> (model, Cmd.none)
Ok el ->
let
origin = (el.element.x, el.element.y)
mouse_pos = model.pos
in
(
{model
|width_ratio=
model.w/distance mouse_pos origin
,pos = origin
}, Cmd.none
)
DragMove btn (( x1, y1 ) as pos) ->
if model.dragMode == DragModeSize then
({model|w=model.width_ratio*distance pos model.pos}, Cmd.none)
else
( { model
| count =
if btn then
model.count + 1
else
0
, pos = pos
, x =
if btn then
model.x + (x1 - Tuple.first model.pos) / 2
else
model.x
, y =
if btn then
model.y + (y1 - Tuple.second model.pos) / 2.5
else
model.y
, drag = btn
}
, Cmd.none
)
DragStop fr ->
( { model | count = 0, drag = False, dragMode = DragModeNone }, Cmd.none )
view : Model -> Html Msg
view model =
div
[ class "sides-0 bg-gainsboro pos-fixed d-flex"
, style "justify-content" "center"
]
[ div
[ w 200
, h 250
, class "rel bg-white"
, style "box-shadow" "0 0 16px gray"
, style "justify-self" "center"
, style "align-self" "center"
]
[ div
[ class "abs sides-0 of-hidden"
]
[ div
-- img pos
[ y model.y
, x model.x
, w 0
, h 0
, class "abs"
]
[ div
-- img
[ class "trans--50 bg-lightgreen"
, w model.w
--, h model.h
, style "aspect-ratio" "3/4"
]
[]
]
]
, div [ class "abs", w 0, h 0
, x model.x, y model.y, id "ctrl_pos"
]
-- ctrl pos
[ div
-- ctrl size
[ w model.w
--, h model.h
, style "aspect-ratio" "3/4"
, class "cur-move trans--50 outline-gray"
--, onClick (\_ -> Increment)
, onDown (\e -> DragStart e.pagePos)
]
[ div
[ w 10
, h 10
, class "abs trans--50 outline-gray"
, x 0
, y 0
, onDown (\e -> DragStartSize e.pagePos)
]
[]
, div
[ class "abs trans--50 outline-gray"
, w 10
, h 10
, y 100
, x 100
, onDown (\e -> DragStartSize e.pagePos)
]
[]
]
]
]
, div [ class "abs" ]
[ text (String.fromInt model.count)
, text " | "
, text (String.fromFloat (Tuple.first model.pos))
, text " "
, text (String.fromFloat (Tuple.second model.pos))
]
]
onClick =
{ stopPropagation = True, preventDefault = True }
|> Mouse.onWithOptions "click"
onDown =
Mouse.onWithOptions
"mousedown"
{ stopPropagation = True, preventDefault = True }
w width =
style "width" (String.fromFloat width ++ "px")
h height =
style "height" (String.fromFloat height ++ "px")
x left =
style "left" (String.fromFloat left ++ "%")
y top =
style "top" (String.fromFloat top ++ "%")
main : Program () Model Msg
main =
Browser.element
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
subscriptions model =
case model.drag of
False ->
Sub.none
True ->
Sub.batch
[ Events.onMouseMove
(D.map2 DragMove decodeButtons decodePagePos)
, Events.onMouseUp
(D.map DragStop decodeFraction)
]
decodeFraction : D.Decoder Float
decodeFraction =
D.map2 (/)
(D.field "pageX" D.float)
(D.at
[ "currentTarget"
, "defaultView"
, "innerWidth"
] D.float
)
decodeButtons : D.Decoder Bool
decodeButtons =
D.field "buttons" (D.map (\buttons -> buttons == 1) D.int)
decodePagePos : D.Decoder ( Float, Float )
decodePagePos =
D.map2 (\a b -> ( a, b ))
(D.field "pageX" D.float)
(D.field "pageY" D.float)
angle_between : ( Float, Float ) -> ( Float, Float ) -> Float
angle_between a b =
atan2 (cross a b) (dot a b) * 180 / pi
cross ( x1, y1 ) ( x2, y2 ) =
x1 * y2 - y1 * x2
dot ( x1, y1 ) ( x2, y2 ) =
x1 * x2 + y1 * y2
hypotenuse a b =
sqrt (a ^ 2 + b ^ 2)
distance ( x1, y1 ) ( x2, y2 ) =
hypotenuse (x1 - x2) (y1 - y2)
sub (x1,y1) (x2,y2) =
(x1 - x2, y1 - y2)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment