Newer
Older
fractals / src / Main.elm
module Main exposing (..)

import Browser
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Svg exposing (..)
import Svg.Attributes exposing (..)


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


type alias Line =
    { start : Point, end : Point }


add a b =
    Point (a.x + b.x) (a.y + b.y)


scale s p =
    Point (s * p.x) (s * p.y)


diff start end =
    add end (scale -1 start)


midpoint s line =
    add line.start (scale s (diff line.start line.end))


rotateMinus90Deg p =
    Point p.y -p.x


tip tipHeight line =
    diff line.start line.end
        |> rotateMinus90Deg
        |> scale ((sqrt 3 / 6) * tipHeight)
        |> add (midpoint 0.5 line)


kochMidPoints tipHeight gapWidth line =
    [ line.start
    , midpoint (0.5 - gapWidth / 2.0) line
    , tip tipHeight line
    , midpoint (0.5 + gapWidth / 2.0) line
    , line.end
    ]


pointListToLinesRec firstPoint remainingPoints lines =
    case remainingPoints of
        p :: ps ->
            pointListToLinesRec p ps (Line firstPoint p :: lines)

        [] ->
            lines


pointListToLines points =
    case points of
        p :: ps ->
            pointListToLinesRec p ps []

        [] ->
            []


kochDivide tipHeight gapWidth line =
    line |> kochMidPoints tipHeight gapWidth |> pointListToLines


kochIteration iterations model lineList =
    if iterations == 0 then
        lineList

    else
        List.concatMap (kochDivide model.tipHeight model.gapWidth) lineList
            |> kochIteration (iterations - 1) model


lineToSvg : Line -> Svg.Svg msg
lineToSvg line =
    Svg.line
        [ x1 (String.fromFloat line.start.x)
        , y1 (String.fromFloat line.start.y)
        , x2 (String.fromFloat line.end.x)
        , y2 (String.fromFloat line.end.y)
        ]
        []


baseHeight =
    200


startLine =
    Line (Point 50 baseHeight) (Point 350 baseHeight)


type alias Model =
    { gapWidth : Float
    , tipHeight : Float
    , iterations : Float
    }


type alias LabelledSliderParameters =
    { id : String
    , label : String
    , min : Float
    , max : Float
    , step : Float
    }


roundToPrecision : Int -> Float -> Float
roundToPrecision precision number =
    toFloat (round (number * toFloat (10 ^ precision))) / toFloat (10 ^ precision)


labelledSlider params msg modelValue =
    div [ Html.Attributes.class "labelled-slider" ]
        [ label [ for params.id ] [ Html.text params.label ]
        , input
            [ Html.Attributes.id params.id
            , Html.Attributes.type_ "range"
            , Html.Attributes.min <| String.fromFloat params.min
            , Html.Attributes.max <| String.fromFloat params.max
            , Html.Attributes.step <| String.fromFloat params.step
            , Html.Attributes.value <| String.fromFloat modelValue
            , onInput msg
            ]
            []
        , span [] [modelValue |> roundToPrecision 2 |> String.fromFloat |> Html.text]
        ]


view : Model -> Html Msg
view model =
    div [ Html.Attributes.class "tile" ]
        [ h2 [] [ Html.text "Koch" ]
        , div []
            [ svg
                [ Svg.Attributes.width "400px"
                , Svg.Attributes.height "400px"
                , Svg.Attributes.style "fill: none; stroke: purple; stroke-width: 1;"
                ]
                ([ startLine ] |> kochIteration model.iterations model |> List.map lineToSvg)
            ]
        , div [ Html.Attributes.class "slider-group" ]
            [ labelledSlider { id = "tipHeight", label = "Tip: ", min = -3, max = 3, step = 0.01 } ChangeTipHeight model.tipHeight
            , labelledSlider { id = "gapWidth", label = "Gap: ", min = -3, max = 3, step = 0.01 } ChangeGapWidth model.gapWidth
            , labelledSlider { id = "iterations", label = "Iterations: ", min = 0, max = 6, step = 1 } ChangeIterations model.iterations
            ]
        ]


init : Model
init =
    { gapWidth = 1 / 3, tipHeight = 1, iterations = 5 }


type Msg
    = ChangeGapWidth String
    | ChangeTipHeight String
    | ChangeIterations String


update : Msg -> Model -> Model
update msg model =
    case msg of
        ChangeGapWidth newWidth ->
            case String.toFloat newWidth of
                Just w ->
                    { model | gapWidth = w }

                Nothing ->
                    model

        ChangeTipHeight newHeight ->
            case String.toFloat newHeight of
                Just h ->
                    { model | tipHeight = h }

                Nothing ->
                    model

        ChangeIterations newIterations ->
            case String.toFloat newIterations of
                Just i ->
                    { model | iterations = i }

                Nothing ->
                    model


main =
    Browser.sandbox { view = view, update = update, init = init }