justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Draw cursor when targeting with HUD

Browse Source
This commit is contained in:
justin
2024-09-30 21:11:56 +01:00
parent d8d3a01f06
commit b7d949c035
11 changed files with 146 additions and 219 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+1 -1
View File
@@ -173,4 +173,4 @@ shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (invLDT' $ _crInv cr)
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a,b,_) -> (a,b))) (invLDT'' $ _crInv cr)
src/Dodge/Data/ComposedItem.hs
-1
View File
@@ -10,7 +10,6 @@ import Data.Aeson
import Data.Aeson.TH
-- it would be nice not to have to import the following...
import Dodge.Data.Item
import Dodge.Data.Item.Use.Consumption.Ammo
import Geometry.Data
import Linear.Quaternion (Quaternion (..))
src/Dodge/Item/Draw.hs
+3 -3
View File
@@ -16,16 +16,16 @@ import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import ShapePicture
itemEquipPict :: Creature -> LabelDoubleTree ComposeLinkType ComposedItem
itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem
-> SPic
itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
-> overPosSP (heldItemOffset itm cr) (itemSPic itmtree)
-> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? equipEffect . eeAttachPos
i <- itm ^? itLocation . ilInvID
epos <- cr ^? crInvEquipped . ix i
return $ equipPosition epos cr attachpos (itemSPic itmtree)
return $ equipPosition epos cr attachpos (itemSPic itm)
where
itm = itmtree ^. ldtValue . _1
src/Dodge/Item/Draw/SPic.hs
+18 -4
View File
@@ -1,7 +1,10 @@
module Dodge.Item.Draw.SPic (
itemSPic,
itemTreeSPic,
) where
import Data.Maybe
import qualified Linear.Quaternion as Q
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Color
@@ -26,8 +29,19 @@ import ShapePicture
-- hit <- itm ^? itType . iyBase . ibtHeld
-- return mempty
itemSPic :: LabelDoubleTree ComposeLinkType ComposedItem -> SPic
itemSPic itmtree = case it ^. itType of
itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
itemTreeSPic (LDT (itm,_) l r) = itemSPic itm
<> foldMap (itemRotTreeSPic itm) (l <> r)
itemRotTreeSPic :: Item -> (ItemLink,LabelDoubleTree ItemLink ComposedItem) -> SPic
itemRotTreeSPic par (il,t) = fromMaybe mempty $ do
(p,q) <- _iatOrient il par itm
return $ (translateSP p $ overPosSP (Q.rotate q) $ itemTreeSPic t)
where
itm = t ^. ldtValue . _1
itemSPic :: Item -> SPic
itemSPic it = case it ^. itType of
CRAFT _ -> defSPic
HELD ht -> heldItemSPic ht it
LEFT lt -> leftItemSPic lt it
@@ -37,8 +51,6 @@ itemSPic itmtree = case it ^. itType of
AMMOMAG {} -> defSPic
TARGETING {} -> defSPic
BULLETMOD {} -> defSPic
where
it = itmtree ^. ldtValue . _1
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
@@ -531,3 +543,5 @@ keyPic =
legsSPic :: Color -> SPic
legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPolyST 3 $ rectWH 2 2
src/Dodge/Item/Grammar.hs
+7 -52
View File
@@ -1,5 +1,6 @@
module Dodge.Item.Grammar (
invLDT',
invLDT'',
invTrees,
invIndentIM,
invAdj,
@@ -21,9 +22,7 @@ import Dodge.DoubleTree
import ListHelp
useBreakListsLinkTest :: [(ItemStructuralFunction,a)]
-> [(ItemStructuralFunction,a)]
-> LinkTest a
useBreakListsLinkTest :: [(ItemStructuralFunction,a)] -> [(ItemStructuralFunction,a)] -> LinkTest a
useBreakListsLinkTest llist rlist = LTest ltest rtest
where
ltest (_,sf,_) = do
@@ -35,35 +34,13 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
(_,linktype) <- safeHead xs
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
basePartiallyComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
basePartiallyComposedItem itm = case itm ^. itType of
HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest
(map (\(i,a) -> (AmmoMagSF a,AmmoInLink i a)) (IM.toList $ itm ^. itUse . heldAmmoTypes))
[(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
)
AMMOMAG _ -> ammoComposedItem itm
TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [(AugmentedHUDSF,AugmentedHUDLink)] [])
ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LTest (const Nothing) (const Nothing))
ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LTest (const Nothing) (const Nothing))
ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
BULLETMOD BulletModTrajectory {} -> nolinks $ AmmoTargetingSF BulletAmmo
BULLETMOD BulletModPayload {} -> nolinks $ AmmoPayloadSF BulletAmmo
BULLETMOD BulletModEffect {} -> nolinks $ AmmoEffectSF BulletAmmo
ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
LEFT {} -> isolate
EQUIP {} -> isolate
CONSUMABLE {} -> isolate
CRAFT {} -> isolate
-- _ ->
where
nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
basePartiallyComposedItem' itm = case itm ^. itType of
HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest
(map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 5 2 0) lhs)))
(map (\(i,a) -> (AmmoMagSF a, ILink (AmmoInLink i a) (c (V3 7 (-2) 0) rhs
)
))
(IM.toList $ itm ^. itUse . heldAmmoTypes))
[noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
)
@@ -85,8 +62,7 @@ basePartiallyComposedItem' itm = case itm ^. itType of
where
noa x y = (x, ILink y (const (const Nothing)))
c x y _ _ = Just (x,y)
lhs = Q.axisAngle (V3 1 0 0) pi
-- rhs = Q.axisAngle (V3 1 0 0) 0
rhs = Q.axisAngle (V3 1 0 0) 0
nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
@@ -107,21 +83,6 @@ ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
where
noa x y = (x, ILink y (const (const Nothing)))
ammoComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
atype <- itm ^? itUse . amagType
return (itm
, AmmoMagSF atype
, useBreakListsLinkTest
[(AmmoModifierSF atype, AmmoModLink)
,(AmmoTargetingSF atype, AmmoTargetingLink)
,(AmmoPayloadSF atype, AmmoPayloadLink)
,(AmmoEffectSF atype, AmmoEffectLink)
,(RemoteScreenSF, RemoteScreenLink)
]
[]
)
type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
@@ -161,18 +122,12 @@ joinItemsInList f xs = snd $ h (xs, [])
Nothing -> h (ys, y : z : zs)
Just w -> h (w : ys, zs)
invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)]
invLDT =
joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
. fmap (singleLDT . basePartiallyComposedItem)
invLDT'' :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
invLDT'' =
joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
. fmap (singleLDT . basePartiallyComposedItem')
invLDT' :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItem]
--invLDT' = map (fmap (\(x,y,_) -> (x,y))) . invLDT
invLDT' = map (first _iatType . second (\(x,y,_) -> (x,y))) . invLDT''
-- this assumes the creature inventory is well formed, specifically the
@@ -206,7 +161,7 @@ invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType C
invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1))
. concatMap ldtToIndentList . invLDT'
-- returns an intmap with trees for all items, including non-roots
-- returns an intmap with trees for all root items
invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
invTrees = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . invLDT'
where
src/Dodge/Machine/Draw.hs
+1 -4
View File
@@ -2,8 +2,6 @@ module Dodge.Machine.Draw
( drawMachine
) where
import Dodge.Data.ComposedItem
import Dodge.DoubleTree
import Dodge.Data.Machine
import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
@@ -60,10 +58,9 @@ drawBaseMachine h mc =
$ _mcWidth mc
drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic ittree)
drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
where
itm = _tuWeapon tu
ittree = singleLDT (itm,UncomposableIsolateSF)
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic (pc, ds) mc =
src/Dodge/Render/ShapePicture.hs
+17 -6
View File
@@ -2,8 +2,10 @@ module Dodge.Render.ShapePicture (
worldSPic,
) where
import Dodge.DoubleTree
import Control.Applicative
import Dodge.Data.DoubleTree
import Dodge.Data.ComposedItem
import Dodge.Item.Grammar
import NewInt
import Dodge.Render.List
import Control.Lens
@@ -37,7 +39,7 @@ worldSPic cfig u =
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup mcSPic (filtOn _mcPos _machines)
<> aimDelaySweep w
<> anyTargeting cfig w
<> anyTargeting w
where
w = _uvWorld u
foldup = foldMap'
@@ -70,9 +72,18 @@ drawSweep cr w = fromMaybe mempty $ do
theinput = w ^. input
mwp = mouseWorldPos theinput campos
anyTargeting :: Configuration -> World -> SPic
anyTargeting _ _ = mempty
--anyTargeting cfig w = fromMaybe mempty $ do
-- assume for now that targeting is above the root,
-- and the augmented hud is above that
anyTargeting :: World -> SPic
anyTargeting w = fromMaybe mempty $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itinvid <- cr ^? crManipulation . manObject . imRootItem
itmtree <- invTrees (_crInv cr) ^? ix itinvid
ttree <- lookup WeaponTargetingLink (itmtree ^. ldtRight)
_ <- lookup AugmentedHUDLink (ttree ^. ldtLeft)
<|> lookup AugmentedHUDLink (ttree ^. ldtRight)
return (mempty , drawTargeting (ttree ^. ldtValue) w)
-- tt <- cr ^? crTargeting . ctType . _Just
-- return $ noShape $ drawTargeting tt cr cfig w
-- where
@@ -164,7 +175,7 @@ floorItemSPic :: FloorItem -> SPic
floorItemSPic flit =
uncurryV translateSPxy (_flItPos flit) $
rotateSP (_flItRot flit)
(itemSPic $ singleLDT ((_flIt flit),UncomposableIsolateSF))
(itemSPic $ _flIt flit)
btSPic :: Button -> SPic
btSPic bt =
src/Dodge/Targeting/Draw.hs
+14 -44
View File
@@ -2,8 +2,9 @@ module Dodge.Targeting.Draw (
drawTargeting,
) where
--import Data.Maybe
--import Dodge.Base
import Dodge.Base.Coordinate
import Data.Maybe
import Control.Lens
import Dodge.Data.Universe
import Geometry.Data
--import Geometry.Vector
@@ -11,40 +12,17 @@ import Geometry.Data
import Picture
--import ShortShow
drawTargeting :: TargetingType -> Creature -> Configuration -> World -> Picture
drawTargeting td = case td of
TargetRBCreature -> targetRBCreatureDraw
TARGETLASER -> targetSimpleDraw
TargetRBPress -> targetSimpleDraw
TargetCursor -> targetSimpleDraw
targetSimpleDraw :: Creature -> Configuration -> World -> Picture
targetSimpleDraw = targetDraw activeTargetCursorPic
--targetDistanceDraw cr _ w = mempty
-- fromMaybe mempty $ do
-- p <- cr ^? crTargeting . ctPos . _Just
-- let p1 = worldPosToScreen cam p
-- mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- p2 = worldPosToScreen cam mwp
-- thecol = if dist p mwp > 100 then red else white
-- return .
-- setLayer FixedCoordLayer $
-- color thecol $
-- line [p1, p2]
-- <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
-- where
-- cam = w ^. wCam
targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
targetDraw _ _ _ _ = mempty
--targetDraw f cr _ _ = mempty
-- fromMaybe mempty $ do
-- p <- cr ^? crTargeting . ctPos . _Just
-- return .
-- setLayer DebugLayer $
-- color white $
-- uncurryV translate p f
-- it would be nice to get rid of some redundant checks here
drawTargeting :: Item -> World -> Picture
drawTargeting itm w = fromMaybe mempty $ do
p <- itm ^? itUse . tgPos . _Just
let thepic = case itm ^? itUse . tgActive of
Just True -> activeTargetCursorPic
_ -> targetCursorPic
return .
setLayer FixedCoordLayer $
color white $
uncurryV translate (worldPosToScreen (w ^. wCam) p) thepic
activeTargetCursorPic :: Picture
activeTargetCursorPic =
@@ -60,14 +38,6 @@ activeTargetCursorPic =
-- | x > x' = min 10 (x - x')
-- | otherwise = max (-10) (x - x')
targetRBCreatureDraw :: Creature -> Configuration -> World -> Picture
targetRBCreatureDraw cr = targetDraw targetCursorPic cr
--targetRBCreatureDraw cr = targetDraw thepic cr
-- where
-- thepic
-- | _ctActive $ _crTargeting cr = activeTargetCursorPic
-- | otherwise = targetCursorPic
targCorner :: Picture
targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
where
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -40,7 +40,7 @@ doWdWd we = case we of
cr <- w ^? cWorld . lWorld . creatures . ix crid
--it <- getItem itid w
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
it <- invTrees (_crInv cr) ^? ix itRef -- note this probably doesn't always work, invTrees probably only returns rooted trees
return $ doItCrWdWd f it cr w
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid