more elm

src/Boid.elm

@@ -4,6 +4,7 @@ import Browser
 import Browser.Events
 import Html
 import Html.Attributes
+import Html.Events
 import Svg
 import Svg.Attributes
 
@@ -20,11 +21,12 @@ main =
 
 subscriptions : Model -> Sub Msg
 subscriptions _ =
-   Browser.Events.onAnimationFrameDelta AnimationFrame
+    Browser.Events.onAnimationFrameDelta AnimationFrame
 
 
 type Msg
     = AnimationFrame Float
+    | SpawnBoid Boid
 
 
 type alias Model =
@@ -46,30 +48,80 @@ makeBoid =
     Boid
         { pos = { x = 0, y = 0 }
         , velocity = { x = 1, y = 1 }
-        , force = { x = 0, y = 0 }
+        , force = { x = -0.001, y = -0.001 }
         }
 
 
-init : a -> ( Model, Cmd msg )
+init : a -> ( Model, Cmd Msg )
 init _ =
-    ( { boids = List.singleton makeBoid
-      , world = { width = 500, height = 500 }
-      }
-    , Cmd.none
-    )
+    { boids = []
+    , world = { width = 500, height = 500 }
+    }
+        |> update (SpawnBoid makeBoid)
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
-    ( { model | boids = List.map updateBoid model.boids }, Cmd.none )
+    case msg of
+        SpawnBoid b ->
+            ( { model | boids = b :: model.boids }, Cmd.none )
+
+        AnimationFrame _ ->
+            ( { model | boids = List.map (calculateForces model.boids >> updateBoid) model.boids }, Cmd.none )
+
+
+calculateForces : List Boid -> Boid -> Boid
+calculateForces bs b =
+    let
+        ( _, others ) =
+            List.partition (\boid -> b == boid) bs
+    in
+    resetForce b
+        |> flyToNeighbours others
+        |> clampForce 1
+
+
+clampForce : Float -> Boid -> Boid
+clampForce limit (Boid boid) =
+    if vlength boid.force > limit then
+        clampForce limit (Boid {boid | force = vscale 0.5 boid.force})
+
+    else
+        Boid boid
+
+
+resetForce : Boid -> Boid
+resetForce (Boid boid) =
+    Boid { boid | force = { x = 0, y = 0 } }
+
+
+flyToNeighbours : List Boid -> Boid -> Boid
+flyToNeighbours neighbours (Boid boid) =
+    if List.length neighbours < 1 then
+        Boid boid
+
+    else
+        let
+            neighbourDraw =
+                List.foldr vadd { x = 0, y = 0 } (List.map pos neighbours)
+                    |> vscale (1 / toFloat (List.length neighbours))
+                    |> vadd (vscale -1 boid.pos)
+                    |> vscale (1 / 100)
+        in
+        Boid { boid | force = vadd boid.force neighbourDraw }
+
+
+pos : Boid -> V2
+pos (Boid b) =
+    b.pos
 
 
 updateBoid : Boid -> Boid
 updateBoid (Boid b) =
     Boid
         { b
             | pos = vadd b.pos b.velocity
-            , velocity = vadd b.velocity b.force
+            , velocity = vadd b.velocity b.force |> vscale 0.99
         }
 
 
@@ -78,12 +130,20 @@ vadd v1 v2 =
     { x = v1.x + v2.x, y = v1.y + v2.y }
 
 
+vscale : Float -> V2 -> V2
+vscale n v =
+    { x = v.x * n, y = v.y * n }
+
+vlength : V2 -> Float
+vlength {x, y} = sqrt (x * x + y * y)
+
 view : Model -> Html.Html Msg
 view model =
     Html.div
         [ Html.Attributes.style "display" "flex"
         , Html.Attributes.style "justify-content" "center"
         , Html.Attributes.style "align-items" "center"
+        , Html.Events.onClick (SpawnBoid makeBoid)
         ]
         [ Svg.svg
             [ Svg.Attributes.width (String.fromInt model.world.width)

src/TicTacToe.elm

@@ -0,0 +1,244 @@
+module TicTacToe exposing (main)
+
+import Browser
+import Browser.Events
+import Dict exposing (Dict)
+import Html exposing (div, text)
+import Html.Attributes exposing (style)
+import Html.Events exposing (onClick)
+import Json.Decode as Decode
+
+
+type alias Model =
+    { field : Dict ( Int, Int ) Player
+    , nextPlayer : Player
+    }
+
+
+type Player
+    = X
+    | O
+
+
+type Row
+    = R1
+    | R2
+    | R3
+
+
+rowNum : Row -> Int
+rowNum r =
+    case r of
+        R1 ->
+            1
+
+        R2 ->
+            2
+
+        R3 ->
+            3
+
+
+type Col
+    = C1
+    | C2
+    | C3
+
+
+colNum : Col -> Int
+colNum r =
+    case r of
+        C1 ->
+            1
+
+        C2 ->
+            2
+
+        C3 ->
+            3
+
+
+toKey : Row -> Col -> ( Int, Int )
+toKey row col =
+    ( rowNum row, colNum col )
+
+
+type Msg
+    = Move Row Col
+    | Reset
+    | NoOp
+
+
+main : Program () Model Msg
+main =
+    Browser.element
+        { init = init
+        , subscriptions = subscriptions
+        , update = update
+        , view = view
+        }
+
+
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+    Browser.Events.onKeyDown (Decode.map toKeyMsg (Decode.field "key" Decode.string))
+
+
+toKeyMsg : String -> Msg
+toKeyMsg string =
+    case string of
+        "r" ->
+            Reset
+
+        _ ->
+            NoOp
+
+
+init : flags -> ( Model, Cmd Msg )
+init _ =
+    ( { field = Dict.empty, nextPlayer = X }, Cmd.none )
+
+
+allSame : Dict ( Int, Int ) Player -> List ( Int, Int ) -> Bool
+allSame field coords =
+    List.all (\c -> Dict.get c field == Just X) coords
+        || List.all (\c -> Dict.get c field == Just O) coords
+
+
+hasWinner : Model -> Bool
+hasWinner { field } =
+    allSame field [ toKey R1 C1, toKey R2 C2, toKey R3 C3 ]
+        || allSame field [ toKey R3 C3, toKey R2 C2, toKey R1 C1 ]
+        || allSame field [ toKey R1 C3, toKey R2 C2, toKey R3 C1 ]
+        || allSame field [ toKey R3 C1, toKey R2 C2, toKey R1 C3 ]
+        || List.any (\r -> allSame field [ toKey r C1, toKey r C2, toKey r C3 ]) rows
+        || List.any (\c -> allSame field [ toKey R1 c, toKey R2 c, toKey R3 c ]) cols
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        NoOp ->
+            ( model, Cmd.none )
+
+        Reset ->
+            ( { field = Dict.empty, nextPlayer = X }, Cmd.none )
+
+        Move r c ->
+            if hasWinner model then
+                ( model, Cmd.none )
+
+            else
+                case Dict.get (toKey r c) model.field of
+                    Just _ ->
+                        ( model, Cmd.none )
+
+                    Nothing ->
+                        ( { model
+                            | field = Dict.insert (toKey r c) model.nextPlayer model.field
+                            , nextPlayer =
+                                case model.nextPlayer of
+                                    X ->
+                                        O
+
+                                    O ->
+                                        X
+                          }
+                        , Cmd.none
+                        )
+
+
+rows : List Row
+rows =
+    [ R1, R2, R3 ]
+
+
+cols : List Col
+cols =
+    [ C1, C2, C3 ]
+
+
+block : Model -> Row -> Col -> Html.Html Msg
+block model row col =
+    div
+        [ onClick (Move row col)
+        , style "backgroundColor" "white"
+        , style "width" "90px"
+        , style "height" "90px"
+        , style "lineHeight" "90px"
+        , style "textAlign" "center"
+        , style "fontSize" "90px"
+        , style "position" "fixed"
+        , style "left"
+            (case col of
+                C1 ->
+                    "0"
+
+                C2 ->
+                    "105px"
+
+                C3 ->
+                    "210px"
+            )
+        , style "top"
+            (case row of
+                R1 ->
+                    "0"
+
+                R2 ->
+                    "105px"
+
+                R3 ->
+                    "210px"
+            )
+        ]
+        [ text
+            (case Dict.get (toKey row col) model.field of
+                Just X ->
+                    "X"
+
+                Just O ->
+                    "O"
+
+                Nothing ->
+                    ""
+            )
+        ]
+
+
+view : Model -> Html.Html Msg
+view model =
+    div []
+        [ div
+            [ style "backgroundColor"
+                (if hasWinner model then
+                    "red"
+
+                 else
+                    "black"
+                )
+            , style "width" "300px"
+            , style "height" "300px"
+            , style "position" "relative"
+            ]
+            (List.concatMap (\r -> List.map (\c -> block model r c) cols) rows)
+        , div
+            [ style "textAlign" "center"
+            , style "width" "300px"
+            ]
+            [ text
+                (case ( hasWinner model, model.nextPlayer ) of
+                    ( True, X ) ->
+                        "Winner is O! Press 'R' to reset."
+
+                    ( True, O ) ->
+                        "Winner is X! Press 'R' to reset."
+
+                    ( False, X ) ->
+                        "Next move: X"
+
+                    ( False, O ) ->
+                        "Next move: O"
+                )
+            ]
+        ]