Implement arcs with variable width and color

src/Dodge/Data/Input.hs

@@ -37,6 +37,7 @@ data Input = Input
     , _rSelect :: Point2
     , _clickMousePos :: Point2
     , _textInput :: T.Text
+    , _scrollTestValue :: Float
     }
 
 data WorldHammer

src/Dodge/Default/World.hs

@@ -27,6 +27,7 @@ defaultInput =
         , _rLine = (0, 0)
         , _lSelect = 0
         , _rSelect = 0
+        , _scrollTestValue = 1
         }
 
 defaultWorld :: World

src/Dodge/Render/ShapePicture.hs

@@ -2,10 +2,12 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import Picture.Test
 import Dodge.Viewpoints
 import Dodge.Render.Label
 import Dodge.WorldEvent.ThingsHit
 import Control.Lens
+--import Control.Monad (guard)
 import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.Map.Strict as M
@@ -53,12 +55,46 @@ worldSPic cfig w =
         <> foldup floorItemSPic (filtOn _flItPos _floorItems)
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup mcSPic (filtOn _mcPos _machines)
+        <> aimDelaySweep cfig w
         <> anyTargeting cfig w
   where
     foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
 
+aimDelaySweep :: Configuration -> World -> SPic
+aimDelaySweep cfig w = fromMaybe mempty $ do
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+--    aimstatus <- cr ^? crStance . posture
+--    guard (aimstatus == Aiming)
+    return $ noShape $ drawSweep cr cfig w
+
+drawSweep :: Creature -> Configuration -> World -> Picture
+drawSweep cr cfig w = fromMaybe mempty $ do
+    --a <- safeArgV (mwp -.- p)
+    return $ winScale cfig
+        $ setLayer FixedCoordLayer
+        $ uncurryV translate (worldPosToScreen campos p) 
+        -- $ thickArcFull (rot + a) 1 white (rot + _crDir cr) 1 white (dist mwp p * campos ^. camZoom)
+--        $ arc (rot + a) (rot + _crDir cr) (dist mwp p * campos ^. camZoom)
+        $ color white (circle 100)
+           -- <> arcTest (3*pi/4) 100 green 0 1 red 100
+            <> arcTest 0 5 green (3*pi/4) 50 red 100 white
+            -- <> f green 0 (pi/2) 100
+--            <> f red 2 3 100
+            <> f blue 4 4.5 100 white
+          --  <> f 0 2 120 <> f 0 3 140 <> f 0 4 160 <> f 1 0 180 <> f 2 0 200 
+          --  <> f 3 0 220 <> f 4 0 240
+          --  <> f (-0.5) 0.5 260 <> f 0.5 (-0.5) 280
+  where
+    f col a b c = arcTest a 25 col b 1 red c
+    --f a b c = thickArc a b c 5
+    --rot = campos ^. camRot
+    p = _crPos cr
+    campos = w ^. cWorld . camPos
+    --theinput = w ^. input
+    --mwp = mouseWorldPos theinput campos
+
 anyTargeting :: Configuration -> World -> SPic
 anyTargeting cfig w = fromMaybe mempty $ do
     tt <- cr ^? crTargeting . ctType . _Just

src/Dodge/ScrollValue.hs

@@ -0,0 +1,9 @@
+module Dodge.ScrollValue where
+
+import Dodge.Data.Input
+import LensHelp
+
+updateScrollTestValue :: Input -> Input
+updateScrollTestValue theinput = theinput & scrollTestValue +~ theamount
+  where
+    theamount = fromIntegral (theinput ^. scrollAmount) / 100

src/Dodge/TestString.hs

@@ -1,6 +1,5 @@
 module Dodge.TestString where
 
-import Dodge.Base.You
 import Control.Lens
 import Dodge.Data.Universe
 --import Data.Maybe
@@ -9,10 +8,8 @@ import Dodge.Data.Universe
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    [ show $ ycr ^?! crInvSel . iselAction
+    [ show $ u ^. uvWorld . input . scrollTestValue
     ]
-  where
-    ycr = you (u ^. uvWorld)
 
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Dodge.ScrollValue
 import Color
 import Control.Applicative
 import Data.List
@@ -74,6 +75,7 @@ updateUniverse u =
         . updateUniverseMid
         . updateUseInput
         . over uvWorld (updateCamera cfig)
+        . over (uvWorld . input) updateScrollTestValue
         . over (uvWorld . cWorld . cClock) (+ 1)
         $ u
   where