From 763b105a2f368e404984359640c5d3cf0ebfa1f6 Mon Sep 17 00:00:00 2001 From: Noah Gordon Date: Thu, 6 Jun 2019 13:45:39 -0400 Subject: [PATCH] Weird stuff going on --- src/Main.elm | 23 +++++- src/Messages.elm | 3 + src/Model.elm | 52 +++++++----- src/Noise/EffectView.elm | 65 +++++++++++++++ src/Noise/Model.elm | 22 ++++++ src/Perlin.elm | 166 +++++++++++++++++++++++++++++++++++++++ src/View.elm | 18 ++--- 7 files changed, 314 insertions(+), 35 deletions(-) create mode 100644 src/Noise/EffectView.elm create mode 100644 src/Noise/Model.elm create mode 100644 src/Perlin.elm diff --git a/src/Main.elm b/src/Main.elm index dce3187..193503a 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -31,6 +31,11 @@ main = { title = Effects.name eff , body = View.draw eff model.otherEffects } + + NoiseEffect eff -> + { title = Effects.name eff + , body = View.draw eff model.otherEffects + } , update = update , subscriptions = subscriptions } @@ -53,6 +58,10 @@ update message model = LightningEffect eff -> LightningEffect <| Effects.tick eff time + + NoiseEffect eff -> + NoiseEffect <| + Effects.tick eff time } , Cmd.none ) @@ -92,16 +101,24 @@ update message model = CloudEffect _ -> False - LightningEffect _ -> + _ -> True LightningEffect _ -> case otherEff of - CloudEffect _ -> + LightningEffect _ -> + False + + _ -> True - LightningEffect _ -> + NoiseEffect _ -> + case otherEff of + NoiseEffect _ -> False + + _ -> + True ) |> List.append [ model.currentEffect ] } diff --git a/src/Messages.elm b/src/Messages.elm index 77090e4..747aab9 100644 --- a/src/Messages.elm +++ b/src/Messages.elm @@ -4,6 +4,7 @@ import Clouds.Model import Html exposing (Html) import Json.Decode as Json import Lightning.Model +import Noise.Model import Time exposing (Posix) @@ -22,11 +23,13 @@ type Effect model mod type MetaEffect = CloudEffect (Effect Clouds.Model.Model CloudModifier) | LightningEffect (Effect Lightning.Model.Model LightningModifier) + | NoiseEffect (Effect Noise.Model.Model ()) type Modifier = CloudMod CloudModifier | LightningMod LightningModifier + | NoiseMod () type CloudModifier diff --git a/src/Model.elm b/src/Model.elm index 5f876d2..51312d1 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -9,6 +9,8 @@ import Lightning.EffectView import Lightning.Model import Lightning.Update import Messages exposing (..) +import Noise.EffectView +import Noise.Model import Time exposing (Posix) @@ -31,27 +33,15 @@ type alias Flags = init : Flags -> ( Model, Cmd Message ) init flags = ( { currentEffect = - CloudEffect <| + NoiseEffect <| Effects.build - { name = "O'Keefe Clouds" - , draw = Clouds.EffectView.draw - , mods = - [ ( Extremity, "funkitude", .extremity ) - , ( Speed, "speed", .speed ) - ] - , model = Clouds.Model.init flags - , tick = Clouds.Update.tick - , modConstructor = CloudMod - , applyModifier = - \effect mod val -> - case mod of - Extremity -> - Effects.updateModel effect - (\m -> { m | extremity = val }) - - Speed -> - Effects.updateModel effect - (\m -> { m | speed = val }) + { name = "Noise" + , draw = Noise.EffectView.draw + , mods = [] + , model = Noise.Model.init flags + , tick = \t m -> { m | time = Time.posixToMillis t } + , modConstructor = NoiseMod + , applyModifier = \eff _ _ -> eff } , otherEffects = [ LightningEffect <| @@ -86,6 +76,28 @@ init flags = Effects.updateModel effect (\m -> { m | zoom = val }) } + , CloudEffect <| + Effects.build + { name = "O'Keefe Clouds" + , draw = Clouds.EffectView.draw + , mods = + [ ( Extremity, "funkitude", .extremity ) + , ( Speed, "speed", .speed ) + ] + , model = Clouds.Model.init flags + , tick = Clouds.Update.tick + , modConstructor = CloudMod + , applyModifier = + \effect mod val -> + case mod of + Extremity -> + Effects.updateModel effect + (\m -> { m | extremity = val }) + + Speed -> + Effects.updateModel effect + (\m -> { m | speed = val }) + } ] } , Cmd.none diff --git a/src/Noise/EffectView.elm b/src/Noise/EffectView.elm new file mode 100644 index 0000000..ff1b451 --- /dev/null +++ b/src/Noise/EffectView.elm @@ -0,0 +1,65 @@ +module Noise.EffectView exposing (draw) + +import Color exposing (Color, rgba) +import Html exposing (Html) +import Messages exposing (Message) +import Noise.Model exposing (..) +import Perlin +import TypedSvg exposing (..) +import TypedSvg.Attributes as Attributes exposing (..) +import TypedSvg.Core exposing (..) +import TypedSvg.Types exposing (..) + + +draw : Model -> Html Message +draw model = + let + imageWidth = + model.window.width - 200 + + baseHeight = + model.window.height / 2 + in + svg + [ width (imageWidth |> px) + , height (model.window.height |> px) + ] + (List.concat + [ [ line + [ x1 (px 20) + , x2 (px <| imageWidth - 20) + , y1 (px baseHeight) + , y2 (px baseHeight) + , stroke (rgba 0 0 0 0.3) + , strokeWidth (px 5) + ] + [] + ] + , List.range 20 (round <| imageWidth - 20) + |> List.map toFloat + |> List.foldl + (\x ( lastY, lines ) -> + let + xPos = + x / imageWidth - 40 + + newY = + Perlin.noise ( xPos, lastY, toFloat model.time / 8640 ) model.seed + in + ( newY + , lines + ++ [ line + [ x1 (px x) + , x2 (px (x + 1)) + , y1 (px (lastY * model.window.height)) + , y2 (px (newY * model.window.height)) + , stroke (rgba 0 0 0 1) + ] + [] + ] + ) + ) + ( Perlin.noise ( 19 / imageWidth - 40, 0, toFloat model.time / 8640 ) model.seed, [] ) + |> Tuple.second + ] + ) diff --git a/src/Noise/Model.elm b/src/Noise/Model.elm new file mode 100644 index 0000000..64b85d4 --- /dev/null +++ b/src/Noise/Model.elm @@ -0,0 +1,22 @@ +module Noise.Model exposing (Model, init) + +import Random + + +type alias Model = + { window : Dimensions + , seed : Random.Seed + , time : Int + } + + +type alias Dimensions = + { width : Float, height : Float } + + +init : { a | window : Dimensions, time : Int } -> Model +init flags = + { window = flags.window + , seed = Random.initialSeed flags.time + , time = flags.time + } diff --git a/src/Perlin.elm b/src/Perlin.elm new file mode 100644 index 0000000..86f6c04 --- /dev/null +++ b/src/Perlin.elm @@ -0,0 +1,166 @@ +module Perlin exposing (noise) + +-- https://flafla2.github.io/2014/08/09/perlinnoise.html + +import Bitwise +import List.Extra as List +import Random + + +noise : ( Float, Float, Float ) -> Random.Seed -> Float +noise ( x, y, z ) seed0 = + let + ( permutation, seed1 ) = + Random.step + (Random.list 512 + (Random.int 0 255) + ) + seed0 + + p : Int -> Int + p int = + List.getAt int permutation + |> Maybe.withDefault 0 + + ( xi, yi, zi ) = + ( floor x + |> Bitwise.and 255 + , floor y + |> Bitwise.and 255 + , floor z + |> Bitwise.and 255 + ) + + ( xf, yf, zf ) = + ( x - toFloat (floor x) + , y - toFloat (floor y) + , z - toFloat (floor z) + ) + + ( u, v, w ) = + ( fade xf, fade yf, fade zf ) + + aaa = + p (p (p xi + yi) + zi) + + aba = + p (p (p xi + yi + 1) + zi) + + aab = + p (p (p xi + yi) + zi + 1) + + abb = + p (p (p xi + yi + 1) + zi + 1) + + baa = + p (p (p (xi + 1) + yi) + zi) + + bba = + p (p (p (xi + 1) + yi + 1) + zi) + + bab = + p (p (p (xi + 1) + yi) + zi + 1) + + bbb = + p (p (p (xi + 1) + yi + 1) + zi + 1) + + x1 = + lerp + ( grad aaa ( xf, yf, zf ) + , grad baa ( xf - 1, yf, zf ) + , u + ) + + x2 = + lerp + ( grad aba ( xf, yf - 1, zf ) + , grad baa ( xf - 1, yf, zf ) + , u + ) + + y1 = + lerp ( x1, x2, v ) + + x1_ = + lerp + ( grad aab ( xf, yf - 1, zf - 1 ) + , grad bab ( xf - 1, yf, zf - 1 ) + , u + ) + + x2_ = + lerp + ( grad abb ( xf, yf - 1, zf - 1 ) + , grad bbb ( xf - 1, yf - 1, zf - 1 ) + , u + ) + + y2 = + lerp ( x1_, x2_, v ) + in + (lerp ( y1, y2, w ) + 1) / 2 + + +fade : Float -> Float +fade t = + t * t * t * (t * (t * 6 - 15) + 10) + + +grad : Int -> ( Float, Float, Float ) -> Float +grad hash ( x, y, z ) = + case Bitwise.and hash 0x0F of + 0x00 -> + x + y + + 0x01 -> + negate x + y + + 0x02 -> + x - y + + 0x03 -> + negate x - y + + 0x04 -> + x + z + + 0x05 -> + negate x + z + + 0x06 -> + x - z + + 0x07 -> + negate x - z + + 0x08 -> + y + z + + 0x09 -> + negate y + z + + 0x0A -> + y - z + + 0x0B -> + negate y - z + + 0x0C -> + y + x + + 0x0D -> + negate y + z + + 0x0E -> + y - x + + 0x0F -> + negate y - z + + _ -> + 0 + + +lerp : ( Float, Float, Float ) -> Float +lerp ( a, b, x ) = + a + x * (b - a) diff --git a/src/View.elm b/src/View.elm index 7a31923..90e300f 100644 --- a/src/View.elm +++ b/src/View.elm @@ -36,22 +36,16 @@ draw effect otherEffects = effectOption : MetaEffect -> Input.Option MetaEffect Message effectOption metaEffect = - let - -- this should be easier too! - name = - case metaEffect of - CloudEffect eff -> - Effects.name eff - - LightningEffect eff -> - Effects.name eff - in + -- this should be easier too! case metaEffect of CloudEffect eff -> - Input.option metaEffect (text name) + Input.option metaEffect (text (Effects.name eff)) LightningEffect eff -> - Input.option metaEffect (text name) + Input.option metaEffect (text (Effects.name eff)) + + NoiseEffect eff -> + Input.option metaEffect (text (Effects.name eff)) modSlider effect ( modifier, label, prop ) =