Refactor targeting

2022-07-21 00:10:05 +01:00
parent a89b0c784f
commit 39117b4dfe
8 changed files with 116 additions and 77 deletions
@@ -0,0 +1,75 @@
+module Dodge.Targeting.Draw where
+import Dodge.Data
+import Dodge.Base
+import Picture
+import Geometry.Vector
+import Geometry.Data
+import LensHelp
+import ShortShow
+
+import Data.Maybe
+
+drawTargeting :: TargetDraw -> Item -> Creature -> Configuration -> World -> Picture
+drawTargeting td = case td of
+    NoTargetDraw -> \_ _ _ _ -> mempty
+    SimpleDrawTarget -> targetSimpleDraw
+    TargetRBCreatureDraw -> targetRBCreatureDraw
+    TargetDistanceDraw -> targetDistanceDraw
+
+targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture
+targetSimpleDraw = targetDraw $ const activeTargetCursorPic
+
+targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
+targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
+    p <- itm ^? itTargeting . tgPos . _Just
+    let p1 = worldPosToScreen w p
+        mwp = mouseWorldPos w
+        p2 = worldPosToScreen w mwp
+        thecol = if dist p mwp > 100 then red else white
+    return $ winScale cfig 
+        $ setLayer FixedCoordLayer 
+        $ color thecol 
+        $ line [p1, p2]
+            <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
+
+targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
+targetDraw f it _ cfig w = fromMaybe mempty $ do
+    p <- it ^? itTargeting . tgPos . _Just
+    return $ winScale cfig 
+        $ setLayer FixedCoordLayer 
+        $ color white 
+        $ uncurryV translate (worldPosToScreen w p)
+        $ f it
+
+activeTargetCursorPic :: Picture
+activeTargetCursorPic = pictures
+    [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]]
+
+transMidLine :: Point2 -> Point2 -> Picture -> Picture
+transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
+  where
+    f (V2 x y) (V2 x' y') 
+        | y > y' && x > x' = max (-10) (x'-x)
+        | y > y' && x < x' = min 10 (x'-x)
+        | x > x'    = min 10 (x-x')
+        | otherwise = max (-10) (x-x')
+
+targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture
+targetRBCreatureDraw = targetDraw thepic
+  where
+    thepic it | _tgActive $ _itTargeting it = activeTargetCursorPic
+        | otherwise = targetCursorPic
+
+targCorner :: Picture
+targCorner = pictures
+    [line [V2   x  x, V2 x (x-y)]
+    ,line [V2   x  x, V2 (x-y) x]
+    ]
+  where
+    x = 10
+    y = 5
+
+targetCursorPic :: Picture
+targetCursorPic = pictures
+    [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]]
+