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

Cleanup, fix broken records in LeftUse

Browse Source
This commit is contained in:
justin
2024-10-03 10:34:17 +01:00
parent e88b3c7443
commit 1953fb2d0c
19 changed files with 71 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (602 modules, at 10:25:01) All good (602 modules, at 10:34:04)
src/Dodge/Creature/Impulse/UseItem.hs
+2 -2
View File
@@ -92,8 +92,8 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
itmat i = _crInv cr IM.! i itmat i = _crInv cr IM.! i
itm = itmat itRef itm = itmat itRef
itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change? itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm' onequip itm' = useE ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm' onremove itm' = useE ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
-- need to make sure that the root item is not erroneously selected in the -- need to make sure that the root item is not erroneously selected in the
-- following -- following
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -142,7 +142,7 @@ applyPastDamages cr w
| otherwise = w | otherwise = w
useEquipment :: Creature -> Int -> World -> World useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr useEquipment cr i = useE (_eeUse (_uequipEffect $ _itUse itm)) itm cr
where where
itm = _crInv cr IM.! i itm = _crInv cr IM.! i
src/Dodge/Data/Item/Use.hs
+1 -1
View File
@@ -46,7 +46,7 @@ data ItemUse
{ _leftUse :: Luse { _leftUse :: Luse
, _leftDelay :: UseDelay , _leftDelay :: UseDelay
, _leftHammer :: HammerPosition , _leftHammer :: HammerPosition
, _equipEffect :: EquipEffect , _uequipEffect :: EquipEffect
, _leftConsumption :: LeftConsumption , _leftConsumption :: LeftConsumption
} }
| UseConsume { _cUse :: Cuse } | UseConsume { _cUse :: Cuse }
src/Dodge/Default/Item/Use.hs
+1 -1
View File
@@ -16,7 +16,7 @@ defaultLeftUse = UseHotkey
{ _leftUse = LDoNothing { _leftUse = LDoNothing
, _leftDelay = FixedRate{_rateMax = 8, _rateTime = 0} , _leftDelay = FixedRate{_rateMax = 8, _rateTime = 0}
, _leftHammer = HammerUp , _leftHammer = HammerUp
, _equipEffect = defaultEquip , _uequipEffect = defaultEquip
, _leftConsumption = defaultLeftLoadable , _leftConsumption = defaultLeftLoadable
} }
src/Dodge/Euse.hs
+5 -5
View File
@@ -83,24 +83,24 @@ useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet
onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = onEquipWristShield itm cr w =
w w
& pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i & pointerToItem itm . itUse . uequipEffect . eeParams .~ EquipID i
& cWorld . lWorld . walls . at i ?~ forceField{_wlID = i} & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr & setWristShieldPos (itm & itUse . uequipEffect . eeParams .~ EquipID i) cr
where where
i = IM.newKey (w ^. cWorld . lWorld . walls) i = IM.newKey (w ^. cWorld . lWorld . walls)
onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ = onRemoveWristShield itm _ =
(pointerToItem itm . itUse . equipEffect . eeParams .~ NoEquipParams) . mremovewall (pointerToItem itm . itUse . uequipEffect . eeParams .~ NoEquipParams) . mremovewall
where where
mremovewall = fromMaybe id $ do mremovewall = fromMaybe id $ do
i <- itm ^? itUse . equipEffect . eeParams . eparamID i <- itm ^? itUse . uequipEffect . eeParams . eparamID
return $ deleteWallID i return $ deleteWallID i
setWristShieldPos :: Item -> Creature -> World -> World setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where where
i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm i = _eparamID $ _eeParams $ _uequipEffect $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm) invid = _ilInvID (_itLocation itm)
handtrans = case cr ^? crInvEquipped . ix invid of handtrans = case cr ^? crInvEquipped . ix invid of
src/Dodge/Inventory.hs
+1 -1
View File
@@ -90,7 +90,7 @@ rmInvItem cid invid w = w
cr = w ^?! cWorld . lWorld . creatures . ix cid cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . equipEffect . eeOnRemove rmf <- itm ^? itUse . uequipEffect . eeOnRemove
return $ useE rmf itm cr return $ useE rmf itm cr
doanyitemeffect = fromMaybe id $ do doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieOnDrop rmf <- itm ^? itEffect . ieOnDrop
src/Dodge/Inventory/RBList.hs
+2 -2
View File
@@ -21,7 +21,7 @@ updateRBList w
EquipOptions{} -> w EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem i <- cr ^? crManipulation . manObject . imSelectedItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite esite <- cr ^? crInv . ix i . itUse . uequipEffect . eeSite
return $ return $
w w
& rbOptions & rbOptions
@@ -47,7 +47,7 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: World -> EquipmentAllocation getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . imSelectedItem curpos <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix curpos . itUse . equipEffect . eeSite esite <- you w ^? crInv . ix curpos . itUse . uequipEffect . eeSite
i <- w ^? rbOptions . opSel i <- w ^? rbOptions . opSel
<|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite)) <|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite))
es <- equipSiteToPositions esite ^? ix i es <- equipSiteToPositions esite ^? ix i
src/Dodge/Item/Display.hs
+1 -1
View File
@@ -132,7 +132,7 @@ showEquipmentNumber _ itm = case _eeUse ee of
EBatterySource{_euseBatteryAmount = x} -> [show x] EBatterySource{_euseBatteryAmount = x} -> [show x]
_ -> [""] _ -> [""]
where where
ee = itm ^?! itUse . equipEffect ee = itm ^?! itUse . uequipEffect
maybeWarmupStatus :: Item -> Maybe String maybeWarmupStatus :: Item -> Maybe String
maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -21,7 +21,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
-> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree) -> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
ituse -> fromMaybe mempty $ do ituse -> fromMaybe mempty $ do
attachpos <- ituse ^? equipEffect . eeAttachPos attachpos <- ituse ^? uequipEffect . eeAttachPos
i <- itm ^? itLocation . ilInvID i <- itm ^? itLocation . ilInvID
epos <- cr ^? crInvEquipped . ix i epos <- cr ^? crInvEquipped . ix i
return $ equipPosition epos cr attachpos (itemSPic itm) return $ equipPosition epos cr attachpos (itemSPic itm)
src/Dodge/Item/Equipment.hs
+28 -37
View File
@@ -28,95 +28,86 @@ magShield :: Item
magShield = magShield =
defaultEquipment defaultEquipment
& itParams .~ MagShieldParams Nothing & itParams .~ MagShieldParams Nothing
& itUse . equipEffect . eeUse .~ EMagShield & itUse . uequipEffect . eeUse .~ EMagShield
& itUse . equipEffect . eeSite .~ GoesOnWrist & itUse . uequipEffect . eeSite .~ GoesOnWrist
& itType .~ EQUIP MAGSHIELD & itType .~ EQUIP MAGSHIELD
flameShield :: Item flameShield :: Item
flameShield = flameShield =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnChest & itUse . uequipEffect . eeSite .~ GoesOnChest
& itType .~ EQUIP FLAMESHIELD & itType .~ EQUIP FLAMESHIELD
frontArmour :: Item frontArmour :: Item
frontArmour = frontArmour =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnChest & itUse . uequipEffect . eeSite .~ GoesOnChest
& itType .~ EQUIP FRONTARMOUR & itType .~ EQUIP FRONTARMOUR
wristArmour :: Item wristArmour :: Item
wristArmour = wristArmour =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist & itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeOnEquip .~ EonWristShield & itUse . uequipEffect . eeOnEquip .~ EonWristShield
& itUse . equipEffect . eeUse .~ EWristShield & itUse . uequipEffect . eeUse .~ EWristShield
& itUse . equipEffect . eeOnRemove .~ EoffWristShield & itUse . uequipEffect . eeOnRemove .~ EoffWristShield
& itType .~ EQUIP WRISTARMOUR & itType .~ EQUIP WRISTARMOUR
batteryPack :: Item batteryPack :: Item
batteryPack = batteryPack =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack & itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-8) 0 10
& itUse . uequipEffect . eeUse .~ EBatterySource 10000 10000
& itType .~ EQUIP BATTERYPACK & itType .~ EQUIP BATTERYPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-8) 0 10
& itUse . equipEffect . eeUse .~ EBatterySource 10000 10000
fuelPack :: Item fuelPack :: Item
fuelPack = fuelPack =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack & itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EFuelSource 10000 10000
& itType .~ EQUIP FUELPACK & itType .~ EQUIP FUELPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EFuelSource 10000 10000
bulletBeltPack :: Item bulletBeltPack :: Item
bulletBeltPack = bulletBeltPack =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack & itUse . uequipEffect . eeSite .~ GoesOnBack
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EAmmoSource 2000 2000 Nothing
& itType .~ EQUIP BULLETBELTPACK & itType .~ EQUIP BULLETBELTPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EAmmoSource 2000 2000 --BulletSource
Nothing
bulletBeltBracer :: Item bulletBeltBracer :: Item
bulletBeltBracer = bulletBeltBracer =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist & itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . uequipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . uequipEffect . eeUse .~ EAmmoSource 100 100 Nothing
& itType .~ EQUIP BULLETBELTBRACER & itType .~ EQUIP BULLETBELTBRACER
& itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
& itUse . equipEffect . eeUse .~ EAmmoSource 100 100 --BulletSource
Nothing
brainHat :: Item brainHat :: Item
brainHat = brainHat =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnHead & itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP BRAINHAT & itType .~ EQUIP BRAINHAT
hat :: Item hat :: Item
hat = hat =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnHead & itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP HAT & itType .~ EQUIP HAT
--targetingHat :: TargetingType -> Item
--targetingHat tt =
-- defaultEquipment
-- & itUse . equipEffect . eeSite .~ GoesOnHead
-- & itType .~ EQUIP (TARGETINGHAT tt)
-- & itUse . equipTargeting ?~ tt
headLamp :: Item headLamp :: Item
headLamp = headLamp =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeUse .~ EHeadLamp & itUse . uequipEffect . eeUse .~ EHeadLamp
& itUse . equipEffect . eeSite .~ GoesOnHead & itUse . uequipEffect . eeSite .~ GoesOnHead
& itType .~ EQUIP HEADLAMP & itType .~ EQUIP HEADLAMP
powerLegs :: Item powerLegs :: Item
powerLegs = powerLegs =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnLegs & itUse . uequipEffect . eeSite .~ GoesOnLegs
& itType .~ EQUIP POWERLEGS & itType .~ EQUIP POWERLEGS
speedLegs :: Item speedLegs :: Item
@@ -128,7 +119,7 @@ jumpLegs = powerLegs & itType .~ EQUIP JUMPLEGS
wristInvisibility :: Item wristInvisibility :: Item
wristInvisibility = wristInvisibility =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist & itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible) & itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
& itUse . equipEffect . eeOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible) & itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
& itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist) & itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
src/Dodge/Item/Info.hs
+1 -1
View File
@@ -219,7 +219,7 @@ aimStanceInfo as = case as of
OneHand -> "It is held in one hand." OneHand -> "It is held in one hand."
itmEquipSiteInfo :: Item -> String itmEquipSiteInfo :: Item -> String
itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . equipEffect . eeSite) itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . uequipEffect . eeSite)
equipSiteInfo :: EquipSite -> String equipSiteInfo :: EquipSite -> String
equipSiteInfo es = case es of equipSiteInfo es = case es of
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -3
View File
@@ -17,11 +17,11 @@ import Sound.Data
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w autoEffect eff t sid itm cr w
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 = | _eparamInt (_eeParams (_uequipEffect $ _itUse itm)) < 1 =
eff itm cr w eff itm cr w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse . itUse
. equipEffect . uequipEffect
. eeParams . eeParams
. eparamInt . eparamInt
.~ t .~ t
@@ -30,7 +30,7 @@ autoEffect eff t sid itm cr w
w w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse . itUse
. equipEffect . uequipEffect
. eeParams . eeParams
. eparamInt . eparamInt
-~ 1 -~ 1
src/Dodge/Item/Weapon/Radar.hs
+8 -7
View File
@@ -1,4 +1,7 @@
module Dodge.Item.Weapon.Radar where module Dodge.Item.Weapon.Radar
( autoDetector
, detectorEffect
) where
import Control.Lens import Control.Lens
import Dodge.Data.World import Dodge.Data.World
@@ -8,14 +11,12 @@ import Dodge.RadarSweep
autoDetector :: Detector -> Item autoDetector :: Detector -> Item
autoDetector dt = autoDetector dt =
defaultEquipment defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnWrist & itUse . uequipEffect . eeSite .~ GoesOnWrist
& itUse . equipEffect . eeUse .~ EDetector dt --autoEffect (detectorEffect dt) 100 click1S & itUse . uequipEffect . eeUse .~ EDetector dt --autoEffect (detectorEffect dt) 100 click1S
& itUse . equipEffect . eeParams .~ EquipCounter 0 & itUse . uequipEffect . eeParams .~ EquipCounter 0
& itUse . equipEffect . eeViewDist ?~ 350 & itUse . uequipEffect . eeViewDist ?~ 350
& itType .~ EQUIP (AUTODETECTOR dt) & itType .~ EQUIP (AUTODETECTOR dt)
-- , _itEffect = autoRadarEffect
detectorEffect :: Detector -> Item -> Creature -> World -> World detectorEffect :: Detector -> Item -> Creature -> World -> World
detectorEffect dt = case dt of detectorEffect dt = case dt of
ITEMDETECTOR -> const (aRadarPulse ObItem) ITEMDETECTOR -> const (aRadarPulse ObItem)
src/Dodge/Item/Weapon/Utility.hs
+5 -27
View File
@@ -17,7 +17,7 @@ stopWatch =
& itUse & itUse
.~ ( defaultLeftUse .~ ( defaultLeftUse
& leftUse .~ LTimePause & leftUse .~ LTimePause
& equipEffect . eeSite .~ GoesOnWrist & uequipEffect . eeSite .~ GoesOnWrist
) )
& itEffect . ieInv .~ ChargeIfEquipped & itEffect . ieInv .~ ChargeIfEquipped
& itEffect . ieOnDrop .~ SetCharge 0 & itEffect . ieOnDrop .~ SetCharge 0
@@ -53,9 +53,8 @@ blinkGun =
defaultLeftItem defaultLeftItem
{ _itUse = { _itUse =
defaultLeftUse defaultLeftUse
& leftUse .~ LBlink --hammerCheckL (shootL $ const blinkAction) & leftUse .~ LBlink
& equipEffect . eeSite .~ GoesOnWrist & uequipEffect . eeSite .~ GoesOnWrist
-- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
} }
& itType .~ LEFT BLINKER & itType .~ LEFT BLINKER
@@ -63,26 +62,5 @@ unsafeBlinkGun :: Item
unsafeBlinkGun = unsafeBlinkGun =
blinkGun blinkGun
& itType .~ LEFT BLINKERUNSAFE & itType .~ LEFT BLINKERUNSAFE
& itUse . leftUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction) & itUse . leftUse .~ LUnsafeBlink
& itUse . equipEffect . eeViewDist ?~ 400 & itUse . uequipEffect . eeViewDist ?~ 400
-- grapGun = defaultGun
-- { _itName = "grapGun"
-- , _itIdentity = GrapGun
-- , _wpMaxAmmo = 1
-- , _wpLoadedAmmo = 1
-- , _wpReloadTime = 40
-- , _wpReloadState = 0
-- , _itUseRate = 10
-- , _itUseTime = 0
-- , _itUse = grapFire
-- , _wpSpread = 0.002
-- , _wpRange = 20
-- , _wpIsAuto = False
-- , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
-- , _itAmount = 1
-- , _itMaxStack = 1
-- , _itAimingSpeed = 1
-- , _itAimingRange = 0.5
-- }
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -133,7 +133,7 @@ drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w) guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . imSelectedItem invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . equipEffect . eeSite eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
i <- w ^? rbOptions . opSel i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w let ae = getEquipmentAllocation w
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
src/Dodge/Targeting/Draw.hs
+7 -20
View File
@@ -2,15 +2,12 @@ module Dodge.Targeting.Draw (
drawTargeting, drawTargeting,
) where ) where
import Dodge.Base.Coordinate
import Data.Maybe
import Control.Lens import Control.Lens
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Data.Universe import Dodge.Data.Universe
import Geometry.Data import Geometry.Data
--import Geometry.Vector
--import LensHelp
import Picture import Picture
--import ShortShow
-- it would be nice to get rid of some redundant checks here -- it would be nice to get rid of some redundant checks here
drawTargeting :: Item -> World -> Picture drawTargeting :: Item -> World -> Picture
@@ -19,24 +16,14 @@ drawTargeting itm w = fromMaybe mempty $ do
let thepic = case itm ^? itUse . tgActive of let thepic = case itm ^? itUse . tgActive of
Just True -> activeTargetCursorPic Just True -> activeTargetCursorPic
_ -> targetCursorPic _ -> targetCursorPic
return . return
setLayer FixedCoordLayer $ . setLayer FixedCoordLayer
color white $ . color white
uncurryV translate (worldPosToScreen (w ^. wCam) p) thepic $ uncurryV translate (worldPosToScreen (w ^. wCam) p) thepic
activeTargetCursorPic :: Picture activeTargetCursorPic :: Picture
activeTargetCursorPic = activeTargetCursorPic =
fold fold [rotate (a * pi) $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5, 1, 1.5]]
[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')
targCorner :: Picture targCorner :: Picture
targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)] targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -116,7 +116,7 @@ moveZoomCamera cfig theinput cr w campos =
wallZoom = min4 (campos ^. camBoundDist) wallZoom = min4 (campos ^. camBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt maxd = max distFromEqmnt
distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment cr distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _uequipEffect . _itUse) $ getCrEquipment cr
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
-- these speeds are inverted, larger means slower -- these speeds are inverted, larger means slower
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -48,7 +48,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
where where
rbscrollmax = fromMaybe 1 $ do rbscrollmax = fromMaybe 1 $ do
invid <- you w ^? crManipulation . manObject . imSelectedItem invid <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix invid . itUse . equipEffect . eeSite esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
return $ length $ equipSiteToPositions esite return $ length $ equipSiteToPositions esite
y = fromIntegral yi y = fromIntegral yi
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1 numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1