My weird framework works

noahzgordon · Jun 5, 2019 · 9dc7e74 · 9dc7e74
1 parent 85d8e53
commit 9dc7e74
Show file tree

Hide file tree

Showing 7 changed files with 106 additions and 35 deletions.
diff --git a/src/Clouds/Model.elm b/src/Clouds/Model.elm
@@ -1,7 +1,6 @@
 module Clouds.Model exposing (Cloud, CloudRow, Coords, Dimensions, Model, buildCloudRow, init)
 
 import List.Extra as List
-import Messages exposing (Message)
 import Random
 import Time exposing (Posix)
 

diff --git a/src/Effects.elm b/src/Effects.elm
@@ -1,28 +1,18 @@
-module Effects exposing (Effect, applyModifier, build, draw, modConstructor, model, modifiers, tick, updateModel)
+module Effects exposing (applyModifier, build, draw, modConstructor, model, modifiers, name, tick, updateModel)
 
 import Html exposing (Html)
 import Messages exposing (..)
 import Time exposing (Posix)
 
 
-type Effect model mod
-    = Effect
-        { draw : model -> Html Message
-        , mods : List ( mod, String, model -> Float )
-        , model : model
-        , tick : Posix -> model -> model
-        , modConstructor : mod -> Modifier
-        , applyModifier : Effect model mod -> mod -> Float -> Effect model mod
-        }
-
-
 build :
     { draw : model -> Html Message
     , mods : List ( mod, String, model -> Float )
     , model : model
     , tick : Posix -> model -> model
     , modConstructor : mod -> Modifier
     , applyModifier : Effect model mod -> mod -> Float -> Effect model mod
+    , name : String
     }
     -> Effect model mod
 build config =
@@ -63,3 +53,8 @@ updateModel (Effect eff) fn =
 applyModifier : Effect model mod -> mod -> Float -> Effect model mod
 applyModifier ((Effect eff) as effect) mod val =
     eff.applyModifier effect mod val
+
+
+name : Effect model mod -> String
+name (Effect eff) =
+    eff.name
diff --git a/src/Lightning/Model.elm b/src/Lightning/Model.elm
@@ -1,6 +1,5 @@
 module Lightning.Model exposing (Arc(..), Bolt, Coords, Dimensions, Model, init)
 
-import Messages exposing (Message)
 import Random
 
 

diff --git a/src/Main.elm b/src/Main.elm
@@ -8,7 +8,7 @@ import Effects
 import Interop
 import List.Extra as List
 import Messages exposing (..)
-import Model exposing (MetaEffect(..), Model)
+import Model exposing (Model)
 import Point2d as Point
 import Random
 import Random.Extra as Random
@@ -23,13 +23,13 @@ main =
             \model ->
                 case model.currentEffect of
                     CloudEffect eff ->
-                        { title = "O'Keefe Clouds"
-                        , body = View.draw eff
+                        { title = Effects.name eff
+                        , body = View.draw eff model.otherEffects
                         }
 
                     LightningEffect eff ->
-                        { title = "Fork Lightning"
-                        , body = View.draw eff
+                        { title = Effects.name eff
+                        , body = View.draw eff model.otherEffects
                         }
         , update = update
         , subscriptions = subscriptions
@@ -78,6 +78,36 @@ update message model =
             , Cmd.none
             )
 
+        UserSelectedEffect eff ->
+            ( { model
+                | currentEffect = eff
+                , otherEffects =
+                    model.otherEffects
+                        |> List.filter
+                            (\otherEff ->
+                                -- this should be easier!
+                                case eff of
+                                    CloudEffect _ ->
+                                        case otherEff of
+                                            CloudEffect _ ->
+                                                False
+
+                                            LightningEffect _ ->
+                                                True
+
+                                    LightningEffect _ ->
+                                        case otherEff of
+                                            CloudEffect _ ->
+                                                True
+
+                                            LightningEffect _ ->
+                                                False
+                            )
+                        |> List.append [ model.currentEffect ]
+              }
+            , Cmd.none
+            )
+
 
 subscriptions : Model -> Sub Message
 subscriptions model =

diff --git a/src/Messages.elm b/src/Messages.elm
@@ -1,9 +1,29 @@
-module Messages exposing (CloudModifier(..), LightningModifier(..), Message(..), Modifier(..))
+module Messages exposing (CloudModifier(..), Effect(..), LightningModifier(..), Message(..), MetaEffect(..), Modifier(..))
 
+import Clouds.Model
+import Html exposing (Html)
 import Json.Decode as Json
+import Lightning.Model
 import Time exposing (Posix)
 
 
+type Effect model mod
+    = Effect
+        { draw : model -> Html Message
+        , mods : List ( mod, String, model -> Float )
+        , model : model
+        , tick : Posix -> model -> model
+        , modConstructor : mod -> Modifier
+        , applyModifier : Effect model mod -> mod -> Float -> Effect model mod
+        , name : String
+        }
+
+
+type MetaEffect
+    = CloudEffect (Effect Clouds.Model.Model CloudModifier)
+    | LightningEffect (Effect Lightning.Model.Model LightningModifier)
+
+
 type Modifier
     = CloudMod CloudModifier
     | LightningMod LightningModifier
@@ -25,3 +45,4 @@ type Message
     = AnimationFrameTriggered Posix
     | ModifierChanged Modifier Float
     | MidiInputReceived Json.Value
+    | UserSelectedEffect MetaEffect
diff --git a/src/Model.elm b/src/Model.elm
@@ -1,9 +1,9 @@
-module Model exposing (MetaEffect(..), Model, init)
+module Model exposing (Model, init)
 
 import Clouds.EffectView
 import Clouds.Model
 import Clouds.Update
-import Effects exposing (Effect)
+import Effects
 import Html exposing (Html)
 import Lightning.EffectView
 import Lightning.Model
@@ -12,11 +12,6 @@ import Messages exposing (..)
 import Time exposing (Posix)
 
 
-type MetaEffect
-    = CloudEffect (Effect Clouds.Model.Model CloudModifier)
-    | LightningEffect (Effect Lightning.Model.Model LightningModifier)
-
-
 type alias Model =
     { currentEffect : MetaEffect
     , otherEffects : List MetaEffect
@@ -38,7 +33,8 @@ init flags =
     ( { currentEffect =
             CloudEffect <|
                 Effects.build
-                    { draw = Clouds.EffectView.draw
+                    { name = "O'Keefe Clouds"
+                    , draw = Clouds.EffectView.draw
                     , mods =
                         [ ( Extremity, "funkitude", .extremity )
                         , ( Speed, "speed", .speed )
@@ -60,7 +56,8 @@ init flags =
       , otherEffects =
             [ LightningEffect <|
                 Effects.build
-                    { draw = Lightning.EffectView.draw
+                    { name = "Fork Lightning"
+                    , draw = Lightning.EffectView.draw
                     , mods =
                         [ ( Fremulation, "fremulation", .fremulation )
                         , ( Chaos, "chaos quotient", .chaos )

diff --git a/src/View.elm b/src/View.elm
@@ -2,28 +2,58 @@ module View exposing (draw)
 
 import Clouds.EffectView
 import Clouds.Model
-import Effects exposing (Effect)
+import Effects
 import Element exposing (..)
 import Element.Background as Background
 import Element.Border as Border
+import Element.Font as Font
 import Element.Input as Input
 import Html exposing (Html)
 import Messages exposing (..)
-import Model exposing (MetaEffect(..), Model)
+import Model exposing (Model)
 
 
-draw : Effect model mod -> List (Html Message)
-draw effect =
+draw : Effect model mod -> List MetaEffect -> List (Html Message)
+draw effect otherEffects =
     [ layout [ width fill, height fill ] <|
         row [ width fill, height fill ]
-            [ column [ width (px 200), height fill, spacing 50, padding 50 ] <|
-                List.map (modSlider effect) (Effects.modifiers effect)
+            [ column [ Font.size 12, width (px 200), height fill, spacing 20, padding 20 ] <|
+                [ text ("Current Effect: " ++ Effects.name effect)
+                , Input.radio []
+                    { onChange = UserSelectedEffect
+                    , options = List.map effectOption otherEffects
+                    , selected = Nothing
+                    , label = Input.labelAbove [] (text "Choose New Effect")
+                    }
+                , column [ width fill ] <|
+                    List.map (modSlider effect) (Effects.modifiers effect)
+                ]
             , el [ width fill, height fill ] <|
                 html (Effects.draw effect)
             ]
     ]
 
 
+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
+    case metaEffect of
+        CloudEffect eff ->
+            Input.option metaEffect (text name)
+
+        LightningEffect eff ->
+            Input.option metaEffect (text name)
+
+
 modSlider effect ( modifier, label, prop ) =
     el
         [ height (px 50)