87 lines
2.8 KiB
Haskell
87 lines
2.8 KiB
Haskell
module Dodge.Targeting.Draw where
|
|
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Data.Universe
|
|
import Geometry.Data
|
|
import Geometry.Vector
|
|
import LensHelp
|
|
import Picture
|
|
import ShortShow
|
|
|
|
drawTargeting :: TargetType -> Item -> Creature -> Configuration -> World -> Picture
|
|
drawTargeting td = case td of
|
|
-- NoTargetDraw -> \_ _ _ _ -> mempty
|
|
TargetRBCreature -> targetRBCreatureDraw
|
|
TargetRBLine -> targetDistanceDraw
|
|
TargetLaser -> \_ _ _ _ -> mempty
|
|
TargetRBPress -> targetSimpleDraw
|
|
TargetCursor -> targetSimpleDraw
|
|
|
|
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 ^? itUse . heldTargeting . tgPos . _Just
|
|
let p1 = worldPosToScreen cam p
|
|
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
|
p2 = worldPosToScreen cam 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)
|
|
where
|
|
cam = w ^. cWorld . camPos
|
|
|
|
targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
|
|
targetDraw f it _ cfig w = fromMaybe mempty $ do
|
|
p <- it ^? itUse . heldTargeting . tgPos . _Just
|
|
return $
|
|
winScale cfig $
|
|
setLayer FixedCoordLayer $
|
|
color white $
|
|
uncurryV translate (worldPosToScreen cam p) $
|
|
f it
|
|
where
|
|
cam = w ^. cWorld . camPos
|
|
|
|
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 $ _heldTargeting $ _itUse 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]]
|