From 5194a0a1692ec8764d7ff75eca2bb3d498998ce0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?D=C3=A9cio=20Ferreira?= Date: Thu, 19 Sep 2024 22:18:24 +0100 Subject: [PATCH] add more examples #22 (#23) --- compiler/src/Data/Graph.elm | 24 +- compiler/src/Reporting/Doc.elm | 10 +- compiler/src/Reporting/Render/Type.elm | 3 +- examples/elm.json | 7 +- examples/src/Animation.elm | 27 ++ examples/src/Book.elm | 90 +++++ examples/src/Crate.elm | 228 ++++++++++++ examples/src/Cube.elm | 189 ++++++++++ examples/src/CurrentTime.elm | 96 +++++ examples/src/DragAndDrop.elm | 139 ++++++++ examples/src/FirstPerson.elm | 376 ++++++++++++++++++++ examples/src/Forms.elm | 87 +++++ examples/src/Groceries.elm | 23 ++ examples/src/ImagePreviews.elm | 163 +++++++++ examples/src/Keyboard.elm | 26 ++ examples/src/Mario.elm | 103 ++++++ examples/src/Mouse.elm | 31 ++ examples/src/Numbers.elm | 85 +++++ examples/src/Picture.elm | 18 + examples/src/Positions.elm | 97 +++++ examples/src/{HttpQuotes.elm => Quotes.elm} | 2 +- examples/src/Shapes.elm | 80 +++++ examples/src/TextFields.elm | 61 ++++ examples/src/Thwomp.elm | 296 +++++++++++++++ examples/src/Triangle.elm | 140 ++++++++ examples/src/Turtle.elm | 35 ++ examples/src/Upload.elm | 87 +++++ review/src/ReviewConfig.elm | 4 +- terminal/src/Develop/Socket.elm | 8 +- tests/backwards-compatibility.test.js | 57 ++- 30 files changed, 2554 insertions(+), 38 deletions(-) create mode 100644 examples/src/Animation.elm create mode 100644 examples/src/Book.elm create mode 100644 examples/src/Crate.elm create mode 100644 examples/src/Cube.elm create mode 100644 examples/src/CurrentTime.elm create mode 100644 examples/src/DragAndDrop.elm create mode 100644 examples/src/FirstPerson.elm create mode 100644 examples/src/Forms.elm create mode 100644 examples/src/Groceries.elm create mode 100644 examples/src/ImagePreviews.elm create mode 100644 examples/src/Keyboard.elm create mode 100644 examples/src/Mario.elm create mode 100644 examples/src/Mouse.elm create mode 100644 examples/src/Numbers.elm create mode 100644 examples/src/Picture.elm create mode 100644 examples/src/Positions.elm rename examples/src/{HttpQuotes.elm => Quotes.elm} (98%) create mode 100644 examples/src/Shapes.elm create mode 100644 examples/src/TextFields.elm create mode 100644 examples/src/Thwomp.elm create mode 100644 examples/src/Triangle.elm create mode 100644 examples/src/Turtle.elm create mode 100644 examples/src/Upload.elm diff --git a/compiler/src/Data/Graph.elm b/compiler/src/Data/Graph.elm index 9c55c6f55..f4bbf1cc2 100644 --- a/compiler/src/Data/Graph.elm +++ b/compiler/src/Data/Graph.elm @@ -4,12 +4,10 @@ module Data.Graph exposing , Graph , SCC(..) , Table - , Vertex - -- , bcc - - , buildG - -- , components - + , Vertex + -- , bcc + , buildG + -- , components , dff , dfs , edges @@ -18,16 +16,14 @@ module Data.Graph exposing , graphFromEdges , graphFromEdges_ , indegree - , outdegree - -- , path - -- , reachable - -- , reverseTopSort - + , outdegree + -- , path + -- , reachable + -- , reverseTopSort , scc , stronglyConnComp - , stronglyConnCompR - -- , topSort - + , stronglyConnCompR + -- , topSort , transposeG , vertices ) diff --git a/compiler/src/Reporting/Doc.elm b/compiler/src/Reporting/Doc.elm index 03acdcdd2..657a44623 100644 --- a/compiler/src/Reporting/Doc.elm +++ b/compiler/src/Reporting/Doc.elm @@ -26,16 +26,14 @@ module Reporting.Doc exposing , fromPackage , fromVersion , green - , hang - -- , hcat - + , hang + -- , hcat , hsep , indent , intToOrdinal , join - , link - -- , magenta - + , link + -- , magenta , makeLink , makeNakedLink , moreArgs diff --git a/compiler/src/Reporting/Render/Type.elm b/compiler/src/Reporting/Render/Type.elm index 46a578879..13254d753 100644 --- a/compiler/src/Reporting/Render/Type.elm +++ b/compiler/src/Reporting/Render/Type.elm @@ -73,8 +73,7 @@ tuple : D.Doc -> D.Doc -> List D.Doc -> D.Doc tuple a b cs = let entries = - List.interweave (D.fromChars "(" :: List.repeat (List.length (b :: cs)) (D.fromChars ",")) (a :: b :: cs) - |> List.intersperse (D.fromChars " ") + List.interweave (D.fromChars "( " :: List.repeat (List.length (b :: cs)) (D.fromChars ", ")) (a :: b :: cs) in D.align <| D.sep [ D.cat entries, D.fromChars ")" ] diff --git a/examples/elm.json b/examples/elm.json index 6a1a998a3..1f59dad67 100644 --- a/examples/elm.json +++ b/examples/elm.json @@ -8,16 +8,19 @@ "direct": { "elm/browser": "1.0.2", "elm/core": "1.0.5", + "elm/file": "1.0.5", "elm/html": "1.0.0", "elm/http": "2.0.0", "elm/json": "1.1.3", "elm/random": "1.0.0", "elm/svg": "1.0.1", - "elm/time": "1.0.0" + "elm/time": "1.0.0", + "elm-explorations/linear-algebra": "1.0.3", + "elm-explorations/webgl": "1.1.3", + "evancz/elm-playground": "1.0.3" }, "indirect": { "elm/bytes": "1.0.8", - "elm/file": "1.0.5", "elm/url": "1.0.0", "elm/virtual-dom": "1.0.3" } diff --git a/examples/src/Animation.elm b/examples/src/Animation.elm new file mode 100644 index 000000000..24f398e57 --- /dev/null +++ b/examples/src/Animation.elm @@ -0,0 +1,27 @@ +module Animation exposing (main) + +-- Create animations that spin, wave, and zig-zag. +-- This one is a little red wagon bumping along a dirt road. +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + +main = + animation view + + +view time = + [ octagon darkGray 36 + |> moveLeft 100 + |> rotate (spin 3 time) + , octagon darkGray 36 + |> moveRight 100 + |> rotate (spin 3 time) + , rectangle red 300 80 + |> moveUp (wave 50 54 2 time) + |> rotate (zigzag -2 2 8 time) + ] diff --git a/examples/src/Book.elm b/examples/src/Book.elm new file mode 100644 index 000000000..bdd67198a --- /dev/null +++ b/examples/src/Book.elm @@ -0,0 +1,90 @@ +module Book exposing (main) + +-- Make a GET request to load a book called "Public Opinion" +-- +-- Read how it works: +-- https://guide.elm-lang.org/effects/http.html +-- + +import Browser +import Html exposing (Html, pre, text) +import Http + + + +-- MAIN + + +main = + Browser.element + { init = init + , update = update + , subscriptions = subscriptions + , view = view + } + + + +-- MODEL + + +type Model + = Failure + | Loading + | Success String + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Loading + , Http.get + { url = "https://elm-lang.org/assets/public-opinion.txt" + , expect = Http.expectString GotText + } + ) + + + +-- UPDATE + + +type Msg + = GotText (Result Http.Error String) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + GotText result -> + case result of + Ok fullText -> + ( Success fullText, Cmd.none ) + + Err _ -> + ( Failure, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + case model of + Failure -> + text "I was unable to load your book." + + Loading -> + text "Loading..." + + Success fullText -> + pre [] [ text fullText ] diff --git a/examples/src/Crate.elm b/examples/src/Crate.elm new file mode 100644 index 000000000..55a97c312 --- /dev/null +++ b/examples/src/Crate.elm @@ -0,0 +1,228 @@ +module Crate exposing (..) + +-- Demonstrate how to load textures and put them on a cube. +-- +-- Dependencies: +-- elm install elm-explorations/linear-algebra +-- elm install elm-explorations/webgl +-- + +import Browser +import Browser.Events as E +import Html exposing (Html) +import Html.Attributes exposing (height, style, width) +import Math.Matrix4 as Mat4 exposing (Mat4) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Math.Vector3 as Vec3 exposing (Vec3, vec3) +import Result +import Task +import WebGL +import WebGL.Texture as Texture + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = \msg model -> ( update msg model, Cmd.none ) + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { angle : Float + , texture : Maybe Texture.Texture + } + + +init : () -> ( Model, Cmd Msg ) +init () = + ( { angle = 0 + , texture = Nothing + } + , Task.attempt GotTexture (Texture.load "https://elm-lang.org/images/wood-crate.jpg") + ) + + + +-- UPDATE + + +type Msg + = TimeDelta Float + | GotTexture (Result Texture.Error Texture.Texture) + + +update : Msg -> Model -> Model +update msg model = + case msg of + TimeDelta dt -> + { model | angle = model.angle + dt / 5000 } + + GotTexture result -> + { model | texture = Result.toMaybe result } + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + E.onAnimationFrameDelta TimeDelta + + + +-- VIEW + + +view : Model -> Html Msg +view model = + case model.texture of + Nothing -> + Html.text "Loading texture..." + + Just texture -> + WebGL.toHtml + [ width 400 + , height 400 + , style "display" "block" + ] + [ WebGL.entity vertexShader fragmentShader crateMesh (toUniforms model.angle texture) + ] + + + +-- UNIFORMS + + +type alias Uniforms = + { rotation : Mat4 + , perspective : Mat4 + , camera : Mat4 + , texture : Texture.Texture + } + + +toUniforms : Float -> Texture.Texture -> Uniforms +toUniforms angle texture = + { rotation = + Mat4.mul + (Mat4.makeRotate (3 * angle) (vec3 0 1 0)) + (Mat4.makeRotate (2 * angle) (vec3 1 0 0)) + , perspective = perspective + , camera = camera + , texture = texture + } + + +perspective : Mat4 +perspective = + Mat4.makePerspective 45 1 0.01 100 + + +camera : Mat4 +camera = + Mat4.makeLookAt (vec3 0 0 5) (vec3 0 0 0) (vec3 0 1 0) + + + +-- MESH + + +type alias Vertex = + { position : Vec3 + , coord : Vec2 + } + + +crateMesh : WebGL.Mesh Vertex +crateMesh = + WebGL.triangles <| + List.concatMap rotatedSquare <| + [ ( 0, 0 ) + , ( 90, 0 ) + , ( 180, 0 ) + , ( 270, 0 ) + , ( 0, 90 ) + , ( 0, 270 ) + ] + + +rotatedSquare : ( Float, Float ) -> List ( Vertex, Vertex, Vertex ) +rotatedSquare ( angleXZ, angleYZ ) = + let + transformMat = + Mat4.mul + (Mat4.makeRotate (degrees angleXZ) Vec3.j) + (Mat4.makeRotate (degrees angleYZ) Vec3.i) + + transform vertex = + { vertex | position = Mat4.transform transformMat vertex.position } + + transformTriangle ( a, b, c ) = + ( transform a, transform b, transform c ) + in + List.map transformTriangle square + + +square : List ( Vertex, Vertex, Vertex ) +square = + let + topLeft = + Vertex (vec3 -1 1 1) (vec2 0 1) + + topRight = + Vertex (vec3 1 1 1) (vec2 1 1) + + bottomLeft = + Vertex (vec3 -1 -1 1) (vec2 0 0) + + bottomRight = + Vertex (vec3 1 -1 1) (vec2 1 0) + in + [ ( topLeft, topRight, bottomLeft ) + , ( bottomLeft, topRight, bottomRight ) + ] + + + +-- SHADERS + + +vertexShader : WebGL.Shader Vertex Uniforms { vcoord : Vec2 } +vertexShader = + [glsl| + attribute vec3 position; + attribute vec2 coord; + uniform mat4 perspective; + uniform mat4 camera; + uniform mat4 rotation; + varying vec2 vcoord; + + void main () { + gl_Position = perspective * camera * rotation * vec4(position, 1.0); + vcoord = coord; + } + |] + + +fragmentShader : WebGL.Shader {} Uniforms { vcoord : Vec2 } +fragmentShader = + [glsl| + precision mediump float; + uniform sampler2D texture; + varying vec2 vcoord; + + void main () { + gl_FragColor = texture2D(texture, vcoord); + } + |] diff --git a/examples/src/Cube.elm b/examples/src/Cube.elm new file mode 100644 index 000000000..dcfed360c --- /dev/null +++ b/examples/src/Cube.elm @@ -0,0 +1,189 @@ +module Cube exposing (main) + +-- Render a spinning cube. +-- +-- Dependencies: +-- elm install elm-explorations/linear-algebra +-- elm install elm-explorations/webgl +-- + +import Browser +import Browser.Events as E +import Html exposing (Html) +import Html.Attributes exposing (height, style, width) +import Math.Matrix4 as Mat4 exposing (Mat4) +import Math.Vector3 as Vec3 exposing (Vec3, vec3) +import WebGL + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + Float + + +init : () -> ( Model, Cmd Msg ) +init () = + ( 0, Cmd.none ) + + + +-- UPDATE + + +type Msg + = TimeDelta Float + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg angle = + case msg of + TimeDelta dt -> + ( angle + dt / 5000, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + E.onAnimationFrameDelta TimeDelta + + + +-- VIEW + + +view : Model -> Html Msg +view angle = + WebGL.toHtml + [ width 400 + , height 400 + , style "display" "block" + ] + [ WebGL.entity vertexShader fragmentShader cubeMesh (uniforms angle) + ] + + +type alias Uniforms = + { rotation : Mat4 + , perspective : Mat4 + , camera : Mat4 + } + + +uniforms : Float -> Uniforms +uniforms angle = + { rotation = + Mat4.mul + (Mat4.makeRotate (3 * angle) (vec3 0 1 0)) + (Mat4.makeRotate (2 * angle) (vec3 1 0 0)) + , perspective = Mat4.makePerspective 45 1 0.01 100 + , camera = Mat4.makeLookAt (vec3 0 0 5) (vec3 0 0 0) (vec3 0 1 0) + } + + + +-- MESH + + +type alias Vertex = + { color : Vec3 + , position : Vec3 + } + + +cubeMesh : WebGL.Mesh Vertex +cubeMesh = + let + rft = + vec3 1 1 1 + + lft = + vec3 -1 1 1 + + lbt = + vec3 -1 -1 1 + + rbt = + vec3 1 -1 1 + + rbb = + vec3 1 -1 -1 + + rfb = + vec3 1 1 -1 + + lfb = + vec3 -1 1 -1 + + lbb = + vec3 -1 -1 -1 + in + WebGL.triangles <| + List.concat <| + [ face (vec3 115 210 22) rft rfb rbb rbt -- green + , face (vec3 52 101 164) rft rfb lfb lft -- blue + , face (vec3 237 212 0) rft lft lbt rbt -- yellow + , face (vec3 204 0 0) rfb lfb lbb rbb -- red + , face (vec3 117 80 123) lft lfb lbb lbt -- purple + , face (vec3 245 121 0) rbt rbb lbb lbt -- orange + ] + + +face : Vec3 -> Vec3 -> Vec3 -> Vec3 -> Vec3 -> List ( Vertex, Vertex, Vertex ) +face color a b c d = + let + vertex position = + Vertex (Vec3.scale (1 / 255) color) position + in + [ ( vertex a, vertex b, vertex c ) + , ( vertex c, vertex d, vertex a ) + ] + + + +-- SHADERS + + +vertexShader : WebGL.Shader Vertex Uniforms { vcolor : Vec3 } +vertexShader = + [glsl| + attribute vec3 position; + attribute vec3 color; + uniform mat4 perspective; + uniform mat4 camera; + uniform mat4 rotation; + varying vec3 vcolor; + void main () { + gl_Position = perspective * camera * rotation * vec4(position, 1.0); + vcolor = color; + } + |] + + +fragmentShader : WebGL.Shader {} Uniforms { vcolor : Vec3 } +fragmentShader = + [glsl| + precision mediump float; + varying vec3 vcolor; + void main () { + gl_FragColor = 0.8 * vec4(vcolor, 1.0); + } + |] diff --git a/examples/src/CurrentTime.elm b/examples/src/CurrentTime.elm new file mode 100644 index 000000000..bd62a51f5 --- /dev/null +++ b/examples/src/CurrentTime.elm @@ -0,0 +1,96 @@ +module CurrentTime exposing (main) + +-- Show the current time in your time zone. +-- +-- Read how it works: +-- https://guide.elm-lang.org/effects/time.html +-- +-- For an analog clock, check out this SVG example: +-- https://elm-lang.org/examples/clock +-- + +import Browser +import Html exposing (..) +import Task +import Time + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { zone : Time.Zone + , time : Time.Posix + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Model Time.utc (Time.millisToPosix 0) + , Task.perform AdjustTimeZone Time.here + ) + + + +-- UPDATE + + +type Msg + = Tick Time.Posix + | AdjustTimeZone Time.Zone + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Tick newTime -> + ( { model | time = newTime } + , Cmd.none + ) + + AdjustTimeZone newZone -> + ( { model | zone = newZone } + , Cmd.none + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Time.every 1000 Tick + + + +-- VIEW + + +view : Model -> Html Msg +view model = + let + hour = + String.fromInt (Time.toHour model.zone model.time) + + minute = + String.fromInt (Time.toMinute model.zone model.time) + + second = + String.fromInt (Time.toSecond model.zone model.time) + in + h1 [] [ text (hour ++ ":" ++ minute ++ ":" ++ second) ] diff --git a/examples/src/DragAndDrop.elm b/examples/src/DragAndDrop.elm new file mode 100644 index 000000000..80651eaee --- /dev/null +++ b/examples/src/DragAndDrop.elm @@ -0,0 +1,139 @@ +module DragAndDrop exposing (main) + +-- Image upload with a drag and drop zone. +-- +-- Dependencies: +-- elm install elm/file +-- elm install elm/json +-- + +import Browser +import File exposing (File) +import File.Select as Select +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Json.Decode as D + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { hover : Bool + , files : List File + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Model False [], Cmd.none ) + + + +-- UPDATE + + +type Msg + = Pick + | DragEnter + | DragLeave + | GotFiles File (List File) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Pick -> + ( model + , Select.files [ "image/*" ] GotFiles + ) + + DragEnter -> + ( { model | hover = True } + , Cmd.none + ) + + DragLeave -> + ( { model | hover = False } + , Cmd.none + ) + + GotFiles file files -> + ( { model + | files = file :: files + , hover = False + } + , Cmd.none + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div + [ style "border" + (if model.hover then + "6px dashed purple" + + else + "6px dashed #ccc" + ) + , style "border-radius" "20px" + , style "width" "480px" + , style "height" "100px" + , style "margin" "100px auto" + , style "padding" "20px" + , style "display" "flex" + , style "flex-direction" "column" + , style "justify-content" "center" + , style "align-items" "center" + , hijackOn "dragenter" (D.succeed DragEnter) + , hijackOn "dragover" (D.succeed DragEnter) + , hijackOn "dragleave" (D.succeed DragLeave) + , hijackOn "drop" dropDecoder + ] + [ button [ onClick Pick ] [ text "Upload Images" ] + , span [ style "color" "#ccc" ] [ text (Debug.toString model) ] + ] + + +dropDecoder : D.Decoder Msg +dropDecoder = + D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder) + + +hijackOn : String -> D.Decoder msg -> Attribute msg +hijackOn event decoder = + preventDefaultOn event (D.map hijack decoder) + + +hijack : msg -> ( msg, Bool ) +hijack msg = + ( msg, True ) diff --git a/examples/src/FirstPerson.elm b/examples/src/FirstPerson.elm new file mode 100644 index 000000000..a14dca978 --- /dev/null +++ b/examples/src/FirstPerson.elm @@ -0,0 +1,376 @@ +module FirstPerson exposing (main) + +-- Walk around in 3D space using the keyboard. +-- +-- Dependencies: +-- elm install elm-explorations/linear-algebra +-- elm install elm-explorations/webgl +-- +-- Try adding the ability to crouch or to land on top of the crate! +-- + +import Browser +import Browser.Dom as Dom +import Browser.Events as E +import Html exposing (Html, div, p, text) +import Html.Attributes exposing (height, style, width) +import Json.Decode as D +import Math.Matrix4 as Mat4 exposing (Mat4) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Math.Vector3 as Vec3 exposing (Vec3, vec3) +import Task +import WebGL +import WebGL.Texture as Texture + + + +-- MAIN + + +main : Program () Model Msg +main = + Browser.element + { init = init + , view = view + , update = \msg model -> ( update msg model, Cmd.none ) + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { keys : Keys + , width : Float + , height : Float + , person : Person + , texture : Maybe Texture.Texture + } + + +type alias Keys = + { up : Bool + , left : Bool + , down : Bool + , right : Bool + , space : Bool + } + + +type alias Person = + { position : Vec3 + , velocity : Vec3 + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( { keys = noKeys + , width = 400 + , height = 400 + , person = Person (vec3 0 eyeLevel -10) (vec3 0 0 0) + , texture = Nothing + } + , Cmd.batch + [ Task.attempt GotTexture (Texture.load "https://elm-lang.org/images/wood-crate.jpg") + , Task.perform (\{ viewport } -> Resized viewport.width viewport.height) Dom.getViewport + ] + ) + + +eyeLevel : Float +eyeLevel = + 2 + + +noKeys : Keys +noKeys = + Keys False False False False False + + + +-- UPDATE + + +type Msg + = GotTexture (Result Texture.Error Texture.Texture) + | KeyChanged Bool String + | TimeDelta Float + | Resized Float Float + | VisibilityChanged E.Visibility + + +update : Msg -> Model -> Model +update msg model = + case msg of + GotTexture result -> + { model | texture = Result.toMaybe result } + + KeyChanged isDown key -> + { model | keys = updateKeys isDown key model.keys } + + TimeDelta dt -> + { model | person = updatePerson dt model.keys model.person } + + Resized width height -> + { model + | width = width + , height = height + } + + VisibilityChanged _ -> + { model | keys = noKeys } + + +updateKeys : Bool -> String -> Keys -> Keys +updateKeys isDown key keys = + case key of + " " -> + { keys | space = isDown } + + "ArrowUp" -> + { keys | up = isDown } + + "ArrowLeft" -> + { keys | left = isDown } + + "ArrowDown" -> + { keys | down = isDown } + + "ArrowRight" -> + { keys | right = isDown } + + _ -> + keys + + +updatePerson : Float -> Keys -> Person -> Person +updatePerson dt keys person = + let + velocity = + stepVelocity dt keys person + + position = + Vec3.add person.position (Vec3.scale (dt / 500) velocity) + in + if Vec3.getY position < eyeLevel then + { position = Vec3.setY eyeLevel position + , velocity = Vec3.setY 0 velocity + } + + else + { position = position + , velocity = velocity + } + + +stepVelocity : Float -> Keys -> Person -> Vec3 +stepVelocity dt { left, right, up, down, space } person = + if Vec3.getY person.position > eyeLevel then + Vec3.setY (Vec3.getY person.velocity - dt / 250) person.velocity + + else + let + toV positive negative = + (if positive then + 1 + + else + 0 + ) + - (if negative then + 1 + + else + 0 + ) + in + vec3 (toV left right) + (if space then + 2 + + else + 0 + ) + (toV up down) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ E.onResize (\w h -> Resized (toFloat w) (toFloat h)) + , E.onKeyUp (D.map (KeyChanged False) (D.field "key" D.string)) + , E.onKeyDown (D.map (KeyChanged True) (D.field "key" D.string)) + , E.onAnimationFrameDelta TimeDelta + , E.onVisibilityChange VisibilityChanged + ] + + + +-- VIEW + + +view : Model -> Html Msg +view model = + let + entities = + case model.texture of + Nothing -> + [] + + Just texture -> + [ viewCrate model.width model.height model.person texture ] + in + div + [ style "position" "absolute" + , style "left" "0" + , style "top" "0" + , style "width" (String.fromFloat model.width ++ "px") + , style "height" (String.fromFloat model.height ++ "px") + ] + [ WebGL.toHtmlWith [ WebGL.depth 1, WebGL.clearColor 1 1 1 1 ] + [ style "display" "block" + , width (round model.width) + , height (round model.height) + ] + entities + , keyboardInstructions model.keys + ] + + +viewCrate : Float -> Float -> Person -> Texture.Texture -> WebGL.Entity +viewCrate width height person texture = + let + perspective = + Mat4.mul + (Mat4.makePerspective 45 (width / height) 0.01 100) + (Mat4.makeLookAt person.position (Vec3.add person.position Vec3.k) Vec3.j) + in + WebGL.entity vertexShader + fragmentShader + crate + { texture = texture + , perspective = perspective + } + + +keyboardInstructions : Keys -> Html msg +keyboardInstructions keys = + div + [ style "position" "absolute" + , style "font-family" "monospace" + , style "text-align" "center" + , style "left" "20px" + , style "right" "20px" + , style "top" "20px" + ] + [ p [] [ text "Walk around with a first person perspective." ] + , p [] [ text "Arrows keys to move, space bar to jump." ] + ] + + + +-- MESH + + +type alias Vertex = + { position : Vec3 + , coord : Vec2 + } + + +crate : WebGL.Mesh Vertex +crate = + WebGL.triangles <| + List.concatMap rotatedSquare <| + [ ( 0, 0 ) + , ( 90, 0 ) + , ( 180, 0 ) + , ( 270, 0 ) + , ( 0, 90 ) + , ( 0, -90 ) + ] + + +rotatedSquare : ( Float, Float ) -> List ( Vertex, Vertex, Vertex ) +rotatedSquare ( angleXZ, angleYZ ) = + let + transformMat = + Mat4.mul + (Mat4.makeRotate (degrees angleXZ) Vec3.j) + (Mat4.makeRotate (degrees angleYZ) Vec3.i) + + transform vertex = + { vertex + | position = + Mat4.transform transformMat vertex.position + } + + transformTriangle ( a, b, c ) = + ( transform a, transform b, transform c ) + in + List.map transformTriangle square + + +square : List ( Vertex, Vertex, Vertex ) +square = + let + topLeft = + Vertex (vec3 -1 1 1) (vec2 0 1) + + topRight = + Vertex (vec3 1 1 1) (vec2 1 1) + + bottomLeft = + Vertex (vec3 -1 -1 1) (vec2 0 0) + + bottomRight = + Vertex (vec3 1 -1 1) (vec2 1 0) + in + [ ( topLeft, topRight, bottomLeft ) + , ( bottomLeft, topRight, bottomRight ) + ] + + + +-- SHADERS + + +type alias Uniforms = + { texture : Texture.Texture + , perspective : Mat4 + } + + +vertexShader : WebGL.Shader Vertex Uniforms { vcoord : Vec2 } +vertexShader = + [glsl| + attribute vec3 position; + attribute vec2 coord; + uniform mat4 perspective; + varying vec2 vcoord; + + void main () { + gl_Position = perspective * vec4(position, 1.0); + vcoord = coord; + } + |] + + +fragmentShader : WebGL.Shader {} Uniforms { vcoord : Vec2 } +fragmentShader = + [glsl| + precision mediump float; + uniform sampler2D texture; + varying vec2 vcoord; + + void main () { + gl_FragColor = texture2D(texture, vcoord); + } + |] diff --git a/examples/src/Forms.elm b/examples/src/Forms.elm new file mode 100644 index 000000000..97d3dbd7d --- /dev/null +++ b/examples/src/Forms.elm @@ -0,0 +1,87 @@ +module Forms exposing (main) + +-- Input a user name and password. Make sure the password matches. +-- +-- Read how it works: +-- https://guide.elm-lang.org/architecture/forms.html +-- + +import Browser +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onInput) + + + +-- MAIN + + +main = + Browser.sandbox { init = init, update = update, view = view } + + + +-- MODEL + + +type alias Model = + { name : String + , password : String + , passwordAgain : String + } + + +init : Model +init = + Model "" "" "" + + + +-- UPDATE + + +type Msg + = Name String + | Password String + | PasswordAgain String + + +update : Msg -> Model -> Model +update msg model = + case msg of + Name name -> + { model | name = name } + + Password password -> + { model | password = password } + + PasswordAgain password -> + { model | passwordAgain = password } + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div [] + [ viewInput "text" "Name" model.name Name + , viewInput "password" "Password" model.password Password + , viewInput "password" "Re-enter Password" model.passwordAgain PasswordAgain + , viewValidation model + ] + + +viewInput : String -> String -> String -> (String -> msg) -> Html msg +viewInput t p v toMsg = + input [ type_ t, placeholder p, value v, onInput toMsg ] [] + + +viewValidation : Model -> Html msg +viewValidation model = + if model.password == model.passwordAgain then + div [ style "color" "green" ] [ text "OK" ] + + else + div [ style "color" "red" ] [ text "Passwords do not match!" ] diff --git a/examples/src/Groceries.elm b/examples/src/Groceries.elm new file mode 100644 index 000000000..80a55a13f --- /dev/null +++ b/examples/src/Groceries.elm @@ -0,0 +1,23 @@ +module Groceries exposing (main) + +-- Show a list of items I need to buy at the grocery store. +-- + +import Html exposing (..) + + +main = + div [] + [ h1 [] [ text "My Grocery List" ] + , ul [] + [ li [] [ text "Black Beans" ] + , li [] [ text "Limes" ] + , li [] [ text "Greek Yogurt" ] + , li [] [ text "Cilantro" ] + , li [] [ text "Honey" ] + , li [] [ text "Sweet Potatoes" ] + , li [] [ text "Cumin" ] + , li [] [ text "Chili Powder" ] + , li [] [ text "Quinoa" ] + ] + ] diff --git a/examples/src/ImagePreviews.elm b/examples/src/ImagePreviews.elm new file mode 100644 index 000000000..c92e300d5 --- /dev/null +++ b/examples/src/ImagePreviews.elm @@ -0,0 +1,163 @@ +module ImagePreviews exposing (main) + +-- Image upload with a drag and drop zone. See image previews! +-- +-- Dependencies: +-- elm install elm/file +-- elm install elm/json +-- + +import Browser +import File exposing (File) +import File.Select as Select +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Json.Decode as D +import Task + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { hover : Bool + , previews : List String + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Model False [], Cmd.none ) + + + +-- UPDATE + + +type Msg + = Pick + | DragEnter + | DragLeave + | GotFiles File (List File) + | GotPreviews (List String) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Pick -> + ( model + , Select.files [ "image/*" ] GotFiles + ) + + DragEnter -> + ( { model | hover = True } + , Cmd.none + ) + + DragLeave -> + ( { model | hover = False } + , Cmd.none + ) + + GotFiles file files -> + ( { model | hover = False } + , Task.perform GotPreviews <| + Task.sequence <| + List.map File.toUrl (file :: files) + ) + + GotPreviews urls -> + ( { model | previews = urls } + , Cmd.none + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div + [ style "border" + (if model.hover then + "6px dashed purple" + + else + "6px dashed #ccc" + ) + , style "border-radius" "20px" + , style "width" "480px" + , style "margin" "100px auto" + , style "padding" "40px" + , style "display" "flex" + , style "flex-direction" "column" + , style "justify-content" "center" + , style "align-items" "center" + , hijackOn "dragenter" (D.succeed DragEnter) + , hijackOn "dragover" (D.succeed DragEnter) + , hijackOn "dragleave" (D.succeed DragLeave) + , hijackOn "drop" dropDecoder + ] + [ button [ onClick Pick ] [ text "Upload Images" ] + , div + [ style "display" "flex" + , style "align-items" "center" + , style "height" "60px" + , style "padding" "20px" + ] + (List.map viewPreview model.previews) + ] + + +viewPreview : String -> Html msg +viewPreview url = + div + [ style "width" "60px" + , style "height" "60px" + , style "background-image" ("url('" ++ url ++ "')") + , style "background-position" "center" + , style "background-repeat" "no-repeat" + , style "background-size" "contain" + ] + [] + + +dropDecoder : D.Decoder Msg +dropDecoder = + D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder) + + +hijackOn : String -> D.Decoder msg -> Attribute msg +hijackOn event decoder = + preventDefaultOn event (D.map hijack decoder) + + +hijack : msg -> ( msg, Bool ) +hijack msg = + ( msg, True ) diff --git a/examples/src/Keyboard.elm b/examples/src/Keyboard.elm new file mode 100644 index 000000000..a3e6752b0 --- /dev/null +++ b/examples/src/Keyboard.elm @@ -0,0 +1,26 @@ +module Keyboard exposing (main) + +-- Move a square around with the arrow keys: UP, DOWN, LEFT, RIGHT +-- Try making it move around more quickly! +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + +main = + game view update ( 0, 0 ) + + +view computer ( x, y ) = + [ square blue 40 + |> move x y + ] + + +update computer ( x, y ) = + ( x + toX computer.keyboard + , y + toY computer.keyboard + ) diff --git a/examples/src/Mario.elm b/examples/src/Mario.elm new file mode 100644 index 000000000..2e8a889db --- /dev/null +++ b/examples/src/Mario.elm @@ -0,0 +1,103 @@ +module Mario exposing (main) + +-- Walk around with the arrow keys. Press the UP arrow to jump! +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + + +-- MAIN + + +main = + game view + update + { x = 0 + , y = 0 + , vx = 0 + , vy = 0 + , dir = "right" + } + + + +-- VIEW + + +view computer mario = + let + w = + computer.screen.width + + h = + computer.screen.height + + b = + computer.screen.bottom + in + [ rectangle (rgb 174 238 238) w h + , rectangle (rgb 74 163 41) w 100 + |> moveY b + , image 70 70 (toGif mario) + |> move mario.x (b + 76 + mario.y) + ] + + +toGif mario = + if mario.y > 0 then + "https://elm-lang.org/images/mario/jump/" ++ mario.dir ++ ".gif" + + else if mario.vx /= 0 then + "https://elm-lang.org/images/mario/walk/" ++ mario.dir ++ ".gif" + + else + "https://elm-lang.org/images/mario/stand/" ++ mario.dir ++ ".gif" + + + +-- UPDATE + + +update computer mario = + let + dt = + 1.666 + + vx = + toX computer.keyboard + + vy = + if mario.y == 0 then + if computer.keyboard.up then + 5 + + else + 0 + + else + mario.vy - dt / 8 + + x = + mario.x + dt * vx + + y = + mario.y + dt * vy + in + { x = x + , y = max 0 y + , vx = vx + , vy = vy + , dir = + if vx == 0 then + mario.dir + + else if vx < 0 then + "left" + + else + "right" + } diff --git a/examples/src/Mouse.elm b/examples/src/Mouse.elm new file mode 100644 index 000000000..ed30453a8 --- /dev/null +++ b/examples/src/Mouse.elm @@ -0,0 +1,31 @@ +module Mouse exposing (main) + +-- Draw a cicle around the mouse. Change its color by pressing down. +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + +main = + game view update () + + +view computer memory = + [ circle lightPurple 30 + |> moveX computer.mouse.x + |> moveY computer.mouse.y + |> fade + (if computer.mouse.down then + 0.2 + + else + 1 + ) + ] + + +update computer memory = + memory diff --git a/examples/src/Numbers.elm b/examples/src/Numbers.elm new file mode 100644 index 000000000..5af8b6fa0 --- /dev/null +++ b/examples/src/Numbers.elm @@ -0,0 +1,85 @@ +module Numbers exposing (main) + +-- Press a button to generate a random number between 1 and 6. +-- +-- Read how it works: +-- https://guide.elm-lang.org/effects/random.html +-- + +import Browser +import Html exposing (..) +import Html.Events exposing (..) +import Random + + + +-- MAIN + + +main = + Browser.element + { init = init + , update = update + , subscriptions = subscriptions + , view = view + } + + + +-- MODEL + + +type alias Model = + { dieFace : Int + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Model 1 + , Cmd.none + ) + + + +-- UPDATE + + +type Msg + = Roll + | NewFace Int + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Roll -> + ( model + , Random.generate NewFace (Random.int 1 6) + ) + + NewFace newFace -> + ( Model newFace + , Cmd.none + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div [] + [ h1 [] [ text (String.fromInt model.dieFace) ] + , button [ onClick Roll ] [ text "Roll" ] + ] diff --git a/examples/src/Picture.elm b/examples/src/Picture.elm new file mode 100644 index 000000000..d767383be --- /dev/null +++ b/examples/src/Picture.elm @@ -0,0 +1,18 @@ +module Picture exposing (main) + +-- Create pictures from simple shapes. Like a tree! +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + +main = + picture + [ rectangle brown 40 200 + |> moveDown 80 + , circle green 100 + |> moveUp 100 + ] diff --git a/examples/src/Positions.elm b/examples/src/Positions.elm new file mode 100644 index 000000000..568c7cf34 --- /dev/null +++ b/examples/src/Positions.elm @@ -0,0 +1,97 @@ +module Positions exposing (main) + +-- A button that moves to random positions when pressed. +-- +-- Dependencies: +-- elm install elm/random +-- + +import Browser +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Random + + + +-- MAIN + + +main = + Browser.element + { init = init + , update = update + , subscriptions = subscriptions + , view = view + } + + + +-- MODEL + + +type alias Model = + { x : Int + , y : Int + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( Model 100 100 + , Cmd.none + ) + + + +-- UPDATE + + +type Msg + = Clicked + | NewPosition ( Int, Int ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Clicked -> + ( model + , Random.generate NewPosition positionGenerator + ) + + NewPosition ( x, y ) -> + ( Model x y + , Cmd.none + ) + + +positionGenerator : Random.Generator ( Int, Int ) +positionGenerator = + Random.map2 Tuple.pair + (Random.int 50 350) + (Random.int 50 350) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + button + [ style "position" "absolute" + , style "top" (String.fromInt model.x ++ "px") + , style "left" (String.fromInt model.y ++ "px") + , onClick Clicked + ] + [ text "Click me!" ] diff --git a/examples/src/HttpQuotes.elm b/examples/src/Quotes.elm similarity index 98% rename from examples/src/HttpQuotes.elm rename to examples/src/Quotes.elm index c35b7ac8b..c0a03490a 100644 --- a/examples/src/HttpQuotes.elm +++ b/examples/src/Quotes.elm @@ -1,4 +1,4 @@ -module HttpQuotes exposing (main) +module Quotes exposing (main) -- Press a button to send a GET request for random quotes. -- diff --git a/examples/src/Shapes.elm b/examples/src/Shapes.elm new file mode 100644 index 000000000..8ba7d19e6 --- /dev/null +++ b/examples/src/Shapes.elm @@ -0,0 +1,80 @@ +module Shapes exposing (main) + +-- Scalable Vector Graphics (SVG) can be a nice way to draw things in 2D. +-- Here are some common SVG shapes. +-- +-- Dependencies: +-- elm install elm/svg +-- + +import Html exposing (Html) +import Svg exposing (..) +import Svg.Attributes exposing (..) + + +main : Html msg +main = + svg + [ viewBox "0 0 400 400" + , width "400" + , height "400" + ] + [ circle + [ cx "50" + , cy "50" + , r "40" + , fill "red" + , stroke "black" + , strokeWidth "3" + ] + [] + , rect + [ x "100" + , y "10" + , width "40" + , height "40" + , fill "green" + , stroke "black" + , strokeWidth "2" + ] + [] + , line + [ x1 "20" + , y1 "200" + , x2 "200" + , y2 "20" + , stroke "blue" + , strokeWidth "10" + , strokeLinecap "round" + ] + [] + , polyline + [ points "200,40 240,40 240,80 280,80 280,120 320,120 320,160" + , fill "none" + , stroke "red" + , strokeWidth "4" + , strokeDasharray "20,2" + ] + [] + , text_ + [ x "130" + , y "130" + , fill "black" + , textAnchor "middle" + , dominantBaseline "central" + , transform "rotate(-45 130,130)" + ] + [ text "Welcome to Shapes Club" + ] + ] + + + +-- There are a lot of odd things about SVG, so always try to find examples +-- to help you understand the weird stuff. Like these: +-- +-- https://www.w3schools.com/graphics/svg_examples.asp +-- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d +-- +-- If you cannot find relevant examples, make an experiment. If you push +-- through the weirdness, you can do a lot with SVG. diff --git a/examples/src/TextFields.elm b/examples/src/TextFields.elm new file mode 100644 index 000000000..ba13e9221 --- /dev/null +++ b/examples/src/TextFields.elm @@ -0,0 +1,61 @@ +module TextFields exposing (main) + +-- A text input for reversing text. Very useful! +-- +-- Read how it works: +-- https://guide.elm-lang.org/architecture/text_fields.html +-- + +import Browser +import Html exposing (Attribute, Html, div, input, text) +import Html.Attributes exposing (..) +import Html.Events exposing (onInput) + + + +-- MAIN + + +main = + Browser.sandbox { init = init, update = update, view = view } + + + +-- MODEL + + +type alias Model = + { content : String + } + + +init : Model +init = + { content = "" } + + + +-- UPDATE + + +type Msg + = Change String + + +update : Msg -> Model -> Model +update msg model = + case msg of + Change newContent -> + { model | content = newContent } + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div [] + [ input [ placeholder "Text to reverse", value model.content, onInput Change ] [] + , div [] [ text (String.reverse model.content) ] + ] diff --git a/examples/src/Thwomp.elm b/examples/src/Thwomp.elm new file mode 100644 index 000000000..4258b332e --- /dev/null +++ b/examples/src/Thwomp.elm @@ -0,0 +1,296 @@ +module Thwomp exposing (main) + +-- Thwomp looks at your mouse. What is it up to? +-- +-- Dependencies: +-- elm install elm/json +-- elm install elm-explorations/linear-algebra +-- elm install elm-explorations/webgl +-- +-- Thanks to The PaperNES Guy for the texture: +-- https://the-papernes-guy.deviantart.com/art/Thwomps-Thwomps-Thwomps-186879685 + +import Browser +import Browser.Dom as Dom +import Browser.Events as E +import Html exposing (Html) +import Html.Attributes exposing (height, style, width) +import Json.Decode as D +import Math.Matrix4 as Mat4 exposing (Mat4) +import Math.Vector2 as Vec2 exposing (Vec2, vec2) +import Math.Vector3 as Vec3 exposing (Vec3, vec3) +import Result +import Task +import WebGL +import WebGL.Texture as Texture + + + +-- MAIN + + +main : Program () Model Msg +main = + Browser.element + { init = init + , view = view + , update = \msg model -> ( update msg model, Cmd.none ) + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { width : Float + , height : Float + , x : Float + , y : Float + , side : Maybe Texture.Texture + , face : Maybe Texture.Texture + } + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( { width = 0 + , height = 0 + , x = 0 + , y = 0 + , face = Nothing + , side = Nothing + } + , Cmd.batch + [ Task.perform GotViewport Dom.getViewport + , Task.attempt GotFace (Texture.loadWith options "https://elm-lang.org/images/thwomp-face.jpg") + , Task.attempt GotSide (Texture.loadWith options "https://elm-lang.org/images/thwomp-side.jpg") + ] + ) + + +options : Texture.Options +options = + { magnify = Texture.nearest + , minify = Texture.nearest + , horizontalWrap = Texture.repeat + , verticalWrap = Texture.repeat + , flipY = True + } + + + +-- UPDATE + + +type Msg + = GotFace (Result Texture.Error Texture.Texture) + | GotSide (Result Texture.Error Texture.Texture) + | GotViewport Dom.Viewport + | Resized Int Int + | MouseMoved Float Float + + +update : Msg -> Model -> Model +update msg model = + case msg of + GotFace result -> + { model + | face = Result.toMaybe result + } + + GotSide result -> + { model + | side = Result.toMaybe result + } + + GotViewport { viewport } -> + { model + | width = viewport.width + , height = viewport.height + } + + Resized width height -> + { model + | width = toFloat width + , height = toFloat height + } + + MouseMoved x y -> + { model + | x = x + , y = y + } + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.batch + [ E.onResize Resized + , E.onMouseMove decodeMovement + ] + + +decodeMovement : D.Decoder Msg +decodeMovement = + D.map2 MouseMoved + (D.field "pageX" D.float) + (D.field "pageY" D.float) + + + +-- VIEW + + +view : Model -> Html Msg +view model = + case Maybe.map2 Tuple.pair model.face model.side of + Nothing -> + Html.text "Loading textures..." + + Just ( face, side ) -> + let + perspective = + toPerspective model.x model.y model.width model.height + in + WebGL.toHtml + [ style "display" "block" + , style "position" "absolute" + , style "left" "0" + , style "top" "0" + , width (round model.width) + , height (round model.height) + ] + [ WebGL.entity vertexShader + fragmentShader + faceMesh + { perspective = perspective + , texture = face + } + , WebGL.entity vertexShader + fragmentShader + sidesMesh + { perspective = perspective + , texture = side + } + ] + + +toPerspective : Float -> Float -> Float -> Float -> Mat4 +toPerspective x y width height = + let + eye = + Vec3.scale 6 <| + Vec3.normalize <| + vec3 (0.5 - x / width) (y / height - 0.5) 1 + in + Mat4.mul + (Mat4.makePerspective 45 (width / height) 0.01 100) + (Mat4.makeLookAt eye (vec3 0 0 0) Vec3.j) + + + +-- MESHES + + +type alias Vertex = + { position : Vec3 + , coord : Vec2 + } + + +faceMesh : WebGL.Mesh Vertex +faceMesh = + WebGL.triangles square + + +sidesMesh : WebGL.Mesh Vertex +sidesMesh = + WebGL.triangles <| + List.concatMap rotatedSquare <| + [ ( 90, 0 ) + , ( 180, 0 ) + , ( 270, 0 ) + , ( 0, 90 ) + , ( 0, 270 ) + ] + + +rotatedSquare : ( Float, Float ) -> List ( Vertex, Vertex, Vertex ) +rotatedSquare ( angleXZ, angleYZ ) = + let + transformMat = + Mat4.mul + (Mat4.makeRotate (degrees angleXZ) Vec3.j) + (Mat4.makeRotate (degrees angleYZ) Vec3.i) + + transform vertex = + { vertex | position = Mat4.transform transformMat vertex.position } + + transformTriangle ( a, b, c ) = + ( transform a, transform b, transform c ) + in + List.map transformTriangle square + + +square : List ( Vertex, Vertex, Vertex ) +square = + let + topLeft = + Vertex (vec3 -1 1 1) (vec2 0 1) + + topRight = + Vertex (vec3 1 1 1) (vec2 1 1) + + bottomLeft = + Vertex (vec3 -1 -1 1) (vec2 0 0) + + bottomRight = + Vertex (vec3 1 -1 1) (vec2 1 0) + in + [ ( topLeft, topRight, bottomLeft ) + , ( bottomLeft, topRight, bottomRight ) + ] + + + +-- SHADERS + + +type alias Uniforms = + { perspective : Mat4 + , texture : Texture.Texture + } + + +vertexShader : WebGL.Shader Vertex Uniforms { vcoord : Vec2 } +vertexShader = + [glsl| + attribute vec3 position; + attribute vec2 coord; + uniform mat4 perspective; + varying vec2 vcoord; + + void main () { + gl_Position = perspective * vec4(position, 1.0); + vcoord = coord.xy; + } + |] + + +fragmentShader : WebGL.Shader {} Uniforms { vcoord : Vec2 } +fragmentShader = + [glsl| + precision mediump float; + uniform sampler2D texture; + varying vec2 vcoord; + + void main () { + gl_FragColor = texture2D(texture, vcoord); + } + |] diff --git a/examples/src/Triangle.elm b/examples/src/Triangle.elm new file mode 100644 index 000000000..751bf9edb --- /dev/null +++ b/examples/src/Triangle.elm @@ -0,0 +1,140 @@ +module Triangle exposing (main) + +-- elm install elm-explorations/linear-algebra +-- elm install elm-explorations/webgl + +import Browser +import Browser.Events as E +import Html exposing (Html) +import Html.Attributes exposing (height, style, width) +import Math.Matrix4 as Mat4 exposing (Mat4) +import Math.Vector3 as Vec3 exposing (Vec3, vec3) +import WebGL + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + Float + + +init : () -> ( Model, Cmd Msg ) +init () = + ( 0, Cmd.none ) + + + +-- UPDATE + + +type Msg + = TimeDelta Float + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg currentTime = + case msg of + TimeDelta delta -> + ( delta + currentTime, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + E.onAnimationFrameDelta TimeDelta + + + +-- VIEW + + +view : Model -> Html msg +view t = + WebGL.toHtml + [ width 400 + , height 400 + , style "display" "block" + ] + [ WebGL.entity vertexShader fragmentShader mesh { perspective = perspective (t / 1000) } + ] + + +perspective : Float -> Mat4 +perspective t = + Mat4.mul + (Mat4.makePerspective 45 1 0.01 100) + (Mat4.makeLookAt (vec3 (4 * cos t) 0 (4 * sin t)) (vec3 0 0 0) (vec3 0 1 0)) + + + +-- MESH + + +type alias Vertex = + { position : Vec3 + , color : Vec3 + } + + +mesh : WebGL.Mesh Vertex +mesh = + WebGL.triangles + [ ( Vertex (vec3 0 0 0) (vec3 1 0 0) + , Vertex (vec3 1 1 0) (vec3 0 1 0) + , Vertex (vec3 1 -1 0) (vec3 0 0 1) + ) + ] + + + +-- SHADERS + + +type alias Uniforms = + { perspective : Mat4 + } + + +vertexShader : WebGL.Shader Vertex Uniforms { vcolor : Vec3 } +vertexShader = + [glsl| + attribute vec3 position; + attribute vec3 color; + uniform mat4 perspective; + varying vec3 vcolor; + + void main () { + gl_Position = perspective * vec4(position, 1.0); + vcolor = color; + } + |] + + +fragmentShader : WebGL.Shader {} Uniforms { vcolor : Vec3 } +fragmentShader = + [glsl| + precision mediump float; + varying vec3 vcolor; + + void main () { + gl_FragColor = vec4(vcolor, 1.0); + } + |] diff --git a/examples/src/Turtle.elm b/examples/src/Turtle.elm new file mode 100644 index 000000000..f10e4aab9 --- /dev/null +++ b/examples/src/Turtle.elm @@ -0,0 +1,35 @@ +module Turtle exposing (main) + +-- Use arrow keys to move the turtle around. +-- +-- Forward with UP and turn with LEFT and RIGHT. +-- +-- Learn more about the playground here: +-- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ +-- + +import Playground exposing (..) + + +main = + game view + update + { x = 0 + , y = 0 + , angle = 0 + } + + +view computer turtle = + [ rectangle blue computer.screen.width computer.screen.height + , image 96 96 "https://elm-lang.org/images/turtle.gif" + |> move turtle.x turtle.y + |> rotate turtle.angle + ] + + +update computer turtle = + { x = turtle.x + toY computer.keyboard * cos (degrees turtle.angle) + , y = turtle.y + toY computer.keyboard * sin (degrees turtle.angle) + , angle = turtle.angle - toX computer.keyboard + } diff --git a/examples/src/Upload.elm b/examples/src/Upload.elm new file mode 100644 index 000000000..13f3925e4 --- /dev/null +++ b/examples/src/Upload.elm @@ -0,0 +1,87 @@ +module Upload exposing (main) + +-- File upload with the node. +-- +-- Dependencies: +-- elm install elm/file +-- elm install elm/json +-- + +import Browser +import File exposing (File) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Json.Decode as D + + + +-- MAIN + + +main = + Browser.element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + List File + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( [], Cmd.none ) + + + +-- UPDATE + + +type Msg + = GotFiles (List File) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + GotFiles files -> + ( files, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + div [] + [ input + [ type_ "file" + , multiple True + , on "change" (D.map GotFiles filesDecoder) + ] + [] + , div [] [ text (Debug.toString model) ] + ] + + +filesDecoder : D.Decoder (List File) +filesDecoder = + D.at [ "target", "files" ] (D.list File.decoder) diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index 32d948b10..712bb7df1 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -36,12 +36,14 @@ import Simplify config : List Rule config = [ --Docs.ReviewAtDocs.rule - NoConfusingPrefixOperator.rule + NoConfusingPrefixOperator.rule , NoDebug.Log.rule + --, NoDebug.TodoOrToString.rule -- |> Rule.ignoreErrorsForDirectories [ "tests/" ] , NoExposingEverything.rule , NoImportingEverything.rule [] + --, NoMissingTypeAnnotation.rule --, NoMissingTypeAnnotationInLetIn.rule --, NoMissingTypeExpose.rule diff --git a/terminal/src/Develop/Socket.elm b/terminal/src/Develop/Socket.elm index 6f4828bee..5214d2ae3 100644 --- a/terminal/src/Develop/Socket.elm +++ b/terminal/src/Develop/Socket.elm @@ -5,10 +5,14 @@ import Control.Exception exposing (SomeException, catch) import Data.ByteString.Char8 as BS import Data.IO exposing (IO) import Network.WebSockets as WS -import System.FSNotify.Devel as Notify import System.FSNotify as Notify +import System.FSNotify.Devel as Notify + + +a = + 0 + -a = 0 --watchFile : FilePath -> WS.PendingConnection -> IO () --watchFile watchedFile pendingConnection = diff --git a/tests/backwards-compatibility.test.js b/tests/backwards-compatibility.test.js index 3a2e24ef0..865effa2a 100644 --- a/tests/backwards-compatibility.test.js +++ b/tests/backwards-compatibility.test.js @@ -4,10 +4,47 @@ const childProcess = require("child_process"); const os = require("os"); const tmpDir = os.tmpdir(); -const examples = ["Hello", "Buttons", "Clock", "HttpQuotes", "Cards"]; -const flags = ["no-flags", "debug", "optimize"]; +const defaultFlags = ["no-flags", "debug", "optimize"]; -const generateFlags = function (flag) { +const examples = [ + // HTML + ["Hello", defaultFlags], + ["Groceries", defaultFlags], + ["Shapes", defaultFlags], + // User Input + ["Buttons", defaultFlags], + ["TextFields", defaultFlags], + ["Forms", defaultFlags], + // Random + ["Numbers", defaultFlags], + ["Cards", defaultFlags], + ["Positions", defaultFlags], + // HTTP + ["Book", defaultFlags], + ["Quotes", defaultFlags], + // Time + ["CurrentTime", defaultFlags], + ["Clock", defaultFlags], + // Files + ["Upload", ["no-flags", "debug"]], + ["DragAndDrop", ["no-flags", "debug"]], + ["ImagePreviews", defaultFlags], + // WebGL + // ["Triangle", defaultFlags], + // ["Cube", defaultFlags], + // ["Crate", defaultFlags], + // ["Thwomp", defaultFlags], + // ["FirstPerson", defaultFlags], + // Playground + ["Picture", defaultFlags], + ["Animation", defaultFlags], + ["Mouse", defaultFlags], + ["Keyboard", defaultFlags], + ["Turtle", defaultFlags], + ["Mario", defaultFlags], +]; + +const generateCommandFlags = function (flag) { if (flag === "no-flags") { return ""; } else { @@ -18,15 +55,15 @@ const generateFlags = function (flag) { describe("backwards compatibility", () => { describe.each(examples)( "produces the same code as elm for the %s example", - (example) => { - test.each(flags)("%s", (flagOpt) => { - const elmOutput = `${tmpDir}/guida-test-elm-${example}-${flagOpt}-${process.pid}.js`; - const guidaOutput = `${tmpDir}/guida-test-guida-${example}-${flagOpt}-${process.pid}.js`; - const flag = generateFlags(flagOpt); + (example, currentFlags) => { + test.each(currentFlags)("%s", (flag) => { + const elmOutput = `${tmpDir}/guida-test-elm-${example}-${flag}-${process.pid}.js`; + const guidaOutput = `${tmpDir}/guida-test-guida-${example}-${flag}-${process.pid}.js`; + const commandFlag = generateCommandFlags(flag); try { childProcess.execSync( - `elm make ./src/${example}.elm ${flag} --output ${elmOutput}`, + `elm make ./src/${example}.elm ${commandFlag} --output ${elmOutput}`, { cwd: path.join(__dirname, "..", "examples") } ); } catch (e) { @@ -35,7 +72,7 @@ describe("backwards compatibility", () => { try { childProcess.execSync( - `../bin/index.js make ./src/${example}.elm ${flag} --output ${guidaOutput}`, + `../bin/index.js make ./src/${example}.elm ${commandFlag} --output ${guidaOutput}`, { cwd: path.join(__dirname, "..", "examples") } ); } catch (e) {