Compare commits

...
18 Commits
Author SHA1 Message Date
justin 08716e8ade Add rotate to scope for (hopefully) all torque functions 2023-12-26 23:39:22 +00:00
justin 105de0d120 Add rotation to scope in two torque functions 2023-12-26 23:34:55 +00:00
justin 6ee1249b6d Add comment 2023-12-26 23:11:12 +00:00
justin 12c509a8b0 Split up your control functions 2023-12-26 23:08:44 +00:00
justin 9dafdb99f0 Make movement always directly responsive to WASD 2023-12-26 21:51:23 +00:00
justin 26c55ee7f5 Fix aiming with scope 2023-12-26 21:45:59 +00:00
justin 3b4bef944d Cleanup 2023-12-24 14:20:30 +00:00
justin 494db47945 Partially working attachable scope 2023-12-24 13:16:43 +00:00
justin 210787d2dc Broken commit 2023-12-23 15:14:02 +00:00
justin f26d380c1b Start implementing attachable scroll items 2023-11-08 18:39:38 +00:00
justin 8f0dd8cd1b Add files 2023-09-25 13:39:06 +01:00
justin 0a7f5079ad Work on weapon attachments 2023-09-25 13:38:47 +01:00
justin f9c6769262 Remove _itInvColor 2023-09-25 10:51:24 +01:00
justin 9ee925f13a Commit on returning to work 2023-09-21 09:17:49 +01:00
justin b8f03f7d8c Commit before moving to external weapon magazines 2023-05-30 11:07:30 +01:00
justin 02c34f99f1 Fix muzzle flare 2023-05-29 16:52:29 +01:00
justin 9283ae187f Fix scope rotation after torque 2023-05-28 16:22:54 +01:00
justin 24939094c6 Cleanup 2023-05-28 15:09:42 +01:00
50 changed files with 618 additions and 457 deletions
+20
View File
@@ -1,8 +1,11 @@
module Dodge.Base.You where module Dodge.Base.You where
import TreeHelp
import Dodge.Data.World import Dodge.Data.World
import Dodge.HeldScroll
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Control.Lens import Control.Lens
import Control.Monad
you :: World -> Creature you :: World -> Creature
you w = w ^?! cWorld . lWorld . creatures . ix 0 you w = w ^?! cWorld . lWorld . creatures . ix 0
@@ -15,8 +18,25 @@ yourItem w = do
i <- you w ^? crManipulation . manObject . inInventory . ispItem i <- you w ^? crManipulation . manObject . inInventory . ispItem
_crInv (you w) IM.!? i _crInv (you w) IM.!? i
yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
yourScrollAttachment w = do
i <- you w ^? crManipulation . manObject . inInventory . ispItem
itm <- _crInv (you w) IM.!? i
atparams <- you w ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
guard (canHeldScrollAttach itm atparams)
return (i - 1, atparams)
yourScopeInvID :: World -> Maybe Int
yourScopeInvID w = do
(i, params) <- yourScrollAttachment w
_ <- params ^? opticPos
return i
yourInv :: World -> IM.IntMap Item yourInv :: World -> IM.IntMap Item
yourInv = _crInv . you yourInv = _crInv . you
attachmentTree :: Creature -> [Tree Int]
attachmentTree cr = []
--yourInvSel :: World -> Int --yourInvSel :: World -> Int
--yourInvSel = crSel . you --yourInvSel = crSel . you
+2 -1
View File
@@ -8,6 +8,7 @@ import Dodge.Item.SlotsTaken
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Data.Combine import Dodge.Data.Combine
import Dodge.Item.Display import Dodge.Item.Display
import Dodge.Item.InventoryColor
import Color import Color
--import Dodge.Data.SelectionList --import Dodge.Data.SelectionList
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
@@ -57,7 +58,7 @@ combineList' = map f . combineListInfo
{ _siPictures = basicItemDisplay itm { _siPictures = basicItemDisplay itm
, _siHeight = itSlotsTaken itm , _siHeight = itSlotsTaken itm
, _siIsSelectable = True , _siIsSelectable = True
, _siColor = _itInvColor itm , _siColor = itemInvColor itm
, _siOffX = 0 , _siOffX = 0
, _siOffY = 0 , _siOffY = 0
, _siPayload = CombinableItem is itm strs , _siPayload = CombinableItem is itm strs
-12
View File
@@ -122,18 +122,6 @@ itemCombinations =
moduleCombinations :: [(ModuleSlot, [Item], [([ItemBaseType], ItemModuleType)])] moduleCombinations :: [(ModuleSlot, [Item], [([ItemBaseType], ItemModuleType)])]
moduleCombinations = moduleCombinations =
[ [
( ModRifleMag
,
[ repeater
, autoRifle
, burstRifle
]
,
[ amod [cr STEELDRUM, cr HARDWARE] DRUMMAG
, amod [cr MOTOR, cr HARDWARE] BELTMAG
]
)
,
( ModHeldAttach ( ModHeldAttach
, ,
[ rifle [ rifle
+1 -2
View File
@@ -10,8 +10,7 @@ import LensHelp
moduleModification :: ItemModuleType -> Item -> Item moduleModification :: ItemModuleType -> Item -> Item
moduleModification imt = case imt of moduleModification imt = case imt of
EMPTYMODULE -> id EMPTYMODULE -> id
DRUMMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 45 -- BELTMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 150
BELTMAG -> itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 150
MAGNETMAG -> itUse . heldDelay . rateMax .~ 4 MAGNETMAG -> itUse . heldDelay . rateMax .~ 4
BULPAY BulFlak -> (itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulFlak) BULPAY BulFlak -> (itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulFlak)
. (itUse . heldConsumption . laAmmoType . amBullet . buTimer .~ 3) . (itUse . heldConsumption . laAmmoType . amBullet . buTimer .~ 3)
+18 -7
View File
@@ -1,11 +1,27 @@
module Dodge.Creature.HandPos where module Dodge.Creature.HandPos (
aimingWeaponZeroPos,
aimingMuzzlePos,
aimingMuzzleLength,
translatePointToLeftHand,
translatePointToRightHand,
translatePointToHead,
translateToLeftWrist,
translateToRightWrist,
translateToLeftLeg,
translateToRightLeg,
translateToHead,
translateToChest,
translateToBack,
translateToLeftHand,
translateToRightHand,
) where
import Linear
import Control.Lens import Control.Lens
import Data.Maybe import Data.Maybe
import Dodge.Creature.Test import Dodge.Creature.Test
import Dodge.Data.Creature import Dodge.Data.Creature
import Geometry import Geometry
import Linear
import ShapePicture import ShapePicture
-- the position of a weapon handle -- the position of a weapon handle
@@ -27,11 +43,6 @@ aimingMuzzlePos cr it = fmap ((+ zp) . _mzPos) (it ^.. itUse . heldAim . aimMuzz
where where
zp = aimingWeaponZeroPos cr it zp = aimingWeaponZeroPos cr it
aimingMuzzleOff :: Creature -> Item -> [Point2]
aimingMuzzleOff cr it = fmap (rotateV (_crDir cr) . (+ zp) . _mzPos) (it ^.. itUse . heldAim . aimMuzzles . folded)
where
zp = aimingWeaponZeroPos cr it
aimingMuzzleLength :: Creature -> Item -> Float aimingMuzzleLength :: Creature -> Item -> Float
aimingMuzzleLength cr it = head (aimingMuzzlePos cr it) ^. _x aimingMuzzleLength cr it = head (aimingMuzzlePos cr it) ^. _x
+1
View File
@@ -42,6 +42,7 @@ itemEffect cr it w = case it ^. itUse of
-- ConsumeUse will cause problems if the item is not selected -- ConsumeUse will cause problems if the item is not selected
(ConsumeUse eff _) -> useC eff it cr $ rmInvItem (_crID cr) itRef w (ConsumeUse eff _) -> useC eff it cr $ rmInvItem (_crID cr) itRef w
CraftUse{} -> w CraftUse{} -> w
AttachUse{} -> w
where where
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
hammerTest f = case _crHammerPosition cr of hammerTest f = case _crHammerPosition cr of
+3
View File
@@ -271,6 +271,9 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
| l < m -> it & itUse . leftConsumption . arProgress -~ 1 | l < m -> it & itUse . leftConsumption . arProgress -~ 1
_ -> it _ -> it
-- I feel like there should be a centralised function that supersumes this
-- i.e. a function that deals with all states that depend upon item positioning
-- in the inventory
crGetTargeting :: Creature -> Maybe TargetType crGetTargeting :: Creature -> Maybe TargetType
crGetTargeting cr = do crGetTargeting cr = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem i <- cr ^? crManipulation . manObject . inInventory . ispItem
+10
View File
@@ -25,6 +25,7 @@ module Dodge.Creature.Test (
) where ) where
--import MaybeHelp --import MaybeHelp
--import Control.Applicative
import Control.Lens import Control.Lens
import Data.List (find) import Data.List (find)
import Data.Maybe import Data.Maybe
@@ -46,6 +47,15 @@ crWeaponReady cr = fromMaybe False $ do
AboveSource -> do AboveSource -> do
x <- cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount x <- cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount
return (x > 0) return (x > 0)
BelowSource -> do
x <- cr ^? crInv . ix (i + 1) . itUse . equipEffect . eeUse . euseAmmoAmount
return (x > 0)
EitherSource -> return $
justIsPositive (cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount)
|| justIsPositive (cr ^? crInv . ix (i + 1) . itUse . equipEffect . eeUse . euseAmmoAmount)
where
justIsPositive Nothing = False
justIsPositive (Just x) = x > 0
crCanSeeCr :: Creature -> (World, Creature) -> Bool crCanSeeCr :: Creature -> (World, Creature) -> Bool
crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w
+76 -37
View File
@@ -2,8 +2,6 @@ module Dodge.Creature.YourControl (
yourControl, yourControl,
) where ) where
import Dodge.Creature.Impulse.UseItem
import Dodge.Hotkey
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@@ -11,8 +9,9 @@ import Data.Maybe
import Dodge.Base.Coordinate import Dodge.Base.Coordinate
import Dodge.Base.You import Dodge.Base.You
import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test import Dodge.Creature.Impulse.UseItem
import Dodge.Data.World import Dodge.Data.World
import Dodge.Hotkey
import Dodge.InputFocus import Dodge.InputFocus
import Dodge.WASD import Dodge.WASD
import Geometry import Geometry
@@ -92,21 +91,72 @@ tryAssignHotkey w sc = fromMaybe w $ do
itid <- cr ^? crManipulation . manObject . inInventory . ispItem itid <- cr ^? crManipulation . manObject . inInventory . ispItem
return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc) return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
-- | Turn key presses into creature movement. {- | Turn key presses into creature movement.
-- | note the order of operation, setting the posture first--this prevents the twist fire bug | note the order of operation, setting the posture first--this prevents the twist fire bug
-}
--wasdWithAiming ::
-- World ->
-- -- | Base speed
-- Float ->
-- Creature ->
-- Creature
--wasdWithAiming w speed cr
-- | isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
-- | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
-- aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
-- | otherwise = theMovement $ theTurn $ removeTwist $ setMvAim cr
-- where
-- setMvAim = maybe id (crMvAim .~) dir
-- twistamount = 1.6
-- removeTwist cr' =
-- cr'
-- & crDir +~ _crTwist cr'
-- & crTwist .~ 0
-- addAnyTwist = fromMaybe id $ do
-- itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
-- astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
-- case (astance, cr ^. crTwist) of
-- (TwoHandUnder, 0) ->
-- return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
-- (TwoHandOver, 0) ->
-- return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
-- _ -> Nothing
-- theMovement
-- | movDir == V2 0 0 = id
-- | otherwise = crMvAbsolute (speed *.* movAbs)
-- theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
-- movDir = wasdDir (w ^. input)
-- dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
-- movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
-- isAiming = _posture (_crStance cr) == Aiming
-- mouseDir = argV $ mouseWorldPos (w ^. input) (w ^. wCam) - (cr ^. crPos)
-- | The order of these MAY be important, in particular the setting of crMvAim
-- within wasdMovement should probably be done first
wasdWithAiming :: wasdWithAiming ::
World -> World ->
-- | Base speed -- | Base speed
Float -> Float ->
Creature -> Creature ->
Creature Creature
wasdWithAiming w speed cr wasdWithAiming w speed = wasdAim inp cam . wasdTwist . wasdMovement inp cam speed
| isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr where
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) = inp = w ^. input
aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr cam = w ^. wCam
| otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr
wasdAim :: Input -> Camera -> Creature -> Creature
wasdAim inp cam cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mouseDir cr
| otherwise = theTurn cr
where
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
mouseDir = argV $ mouseWorldPos inp cam - (cr ^. crPos)
wasdTwist :: Creature -> Creature
wasdTwist cr
| _posture (_crStance cr) == Aiming = addAnyTwist cr
| otherwise = removeTwist cr
where where
setMvAim = maybe id (crMvAim .~) dir
twistamount = 1.6 twistamount = 1.6
removeTwist cr' = removeTwist cr' =
cr' cr'
@@ -115,34 +165,25 @@ wasdWithAiming w speed cr
addAnyTwist = fromMaybe id $ do addAnyTwist = fromMaybe id $ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
let currenttwistamount = cr ^. crTwist case (astance, cr ^. crTwist) of
case (astance, currenttwistamount) of
(TwoHandUnder, 0) -> (TwoHandUnder, 0) ->
return $ return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
(crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
(TwoHandOver, 0) -> (TwoHandOver, 0) ->
return $ return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi)
(crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
_ -> Nothing _ -> Nothing
wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
wasdMovement inp cam speed = theMovement . setMvAim
where
setMvAim = fromMaybe id $ do
dir <- safeArgV movDir
return $ crMvAim .~ (cam ^. camRot + dir)
movDir = wasdDir inp
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement theMovement
| movDir == V2 0 0 = id | movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs) | otherwise = crMvAbsolute (speed *.* movAbs)
noaimmove
| movDir == V2 0 0 = id
| otherwise = crMvForward speed
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
movDir = wasdDir (w ^. input)
dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. wCam . camRot))
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
aimTurn :: Float -> Creature -> Creature aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
@@ -154,11 +195,10 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
-- | Set posture according to mouse presses. -- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys cr mouseActionsCr pkeys cr
| rbPressed && noaction = | SDL.ButtonRight `M.member` pkeys && noaction =
cr & crStance . posture .~ Aiming cr & crStance . posture .~ Aiming
| otherwise = cr & crStance . posture .~ AtEase | otherwise = cr & crStance . posture .~ AtEase
where where
rbPressed = SDL.ButtonRight `M.member` pkeys
noaction = fromMaybe True $ do noaction = fromMaybe True $ do
theaction <- cr ^? crManipulation . manObject . inInventory . iselAction theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
return $ theaction == NoInvSelAction return $ theaction == NoInvSelAction
@@ -167,8 +207,7 @@ pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w pressedMBEffectsTopInventory pkeys w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w
| isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w | isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w
| isDown SDL.ButtonMiddle = | isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
w & wCam . camRot -~ rotation
| otherwise = w | otherwise = w
where where
inTopInv = case w ^. hud . hudElement of inTopInv = case w ^. hud . hudElement of
+10 -2
View File
@@ -16,7 +16,6 @@ module Dodge.Data.Item (
module Dodge.Data.Item.Location, module Dodge.Data.Item.Location,
) where ) where
import Color
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
@@ -29,6 +28,7 @@ import Dodge.Data.Item.Params
import Dodge.Data.Item.Tweak import Dodge.Data.Item.Tweak
import Dodge.Data.Item.Use import Dodge.Data.Item.Use
import Dodge.Data.Item.Location import Dodge.Data.Item.Location
import Data.Set (Set)
data Item = Item data Item = Item
{ _itUse :: ItemUse { _itUse :: ItemUse
@@ -38,17 +38,25 @@ data Item = Item
, _itIsHeld :: Bool , _itIsHeld :: Bool
, _itEffect :: ItEffect , _itEffect :: ItEffect
, _itInvSize :: Float , _itInvSize :: Float
, _itInvColor :: Color
, _itDimension :: ItemDimension , _itDimension :: ItemDimension
, _itCurseStatus :: CurseStatus , _itCurseStatus :: CurseStatus
, _itTweaks :: ItemTweaks , _itTweaks :: ItemTweaks
, _itScope :: Scope , _itScope :: Scope
, _itParams :: ItemParams , _itParams :: ItemParams
, _itAttachments :: Set ItemAttachment
} }
--deriving (Eq, Show, Read) --Generic, Flat) --deriving (Eq, Show, Read) --Generic, Flat)
data ItemAttachment = ScopeAttachment
| BulletClipAttachment
| BulletBeltAttachment
| StandAttachment
| PowerSourceAttachment
deriving (Eq,Ord)
_itUseAimStance :: Item -> AimStance _itUseAimStance :: Item -> AimStance
_itUseAimStance = _aimStance . _heldAim . _itUse _itUseAimStance = _aimStance . _heldAim . _itUse
makeLenses ''Item makeLenses ''Item
deriveJSON defaultOptions ''ItemAttachment
deriveJSON defaultOptions ''Item deriveJSON defaultOptions ''Item
+43 -26
View File
@@ -1,38 +1,38 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Combine where module Dodge.Data.Item.Combine where
import Dodge.Data.Item.Targeting
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Dodge.Data.Equipment.Misc import Dodge.Data.Equipment.Misc
import Dodge.Data.Item.Targeting
import Dodge.Data.Item.Use.Consumption import Dodge.Data.Item.Use.Consumption
data ItemType = ItemType data ItemType = ItemType
{ _iyBase :: ItemBaseType { _iyBase :: ItemBaseType
, _iyModules :: M.Map ModuleSlot ItemModuleType , _iyModules :: M.Map ModuleSlot ItemModuleType
} }
deriving (Eq,Ord,Show,Read) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Stack = NoStack | Stack ItAmount data Stack = NoStack | Stack ItAmount
deriving (Eq,Ord,Show,Read) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CraftType data CraftType
= PIPE = PIPE
| TUBE | TUBE
| HARDWARE | HARDWARE
| SPRING | SPRING
| HOSE | HOSE
| TAPE | TAPE
| CAN | CAN
| TIN | TIN
| STEELDRUM | STEELDRUM
@@ -78,26 +78,44 @@ data CraftType
| TIMEMODULE | TIMEMODULE
| SIZEMODULE | SIZEMODULE
| GRAVITYMODULE | GRAVITYMODULE
| TARGETMODULE TargetType | TARGETMODULE TargetType
deriving (Eq,Ord,Show,Read) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
data ItemBaseType data ItemBaseType
= NoItemType = HELD {_ibtHeld :: HeldItemType}
| HELD {_ibtHeld :: HeldItemType}
| LEFT {_ibtLeft :: LeftItemType} | LEFT {_ibtLeft :: LeftItemType}
| EQUIP {_ibtEquip :: EquipItemType} | EQUIP {_ibtEquip :: EquipItemType}
| Consumable {_ibtConsumable :: ConsumableItemType} | CONSUMABLE {_ibtConsumable :: ConsumableItemType}
| CRAFT CraftType | CRAFT CraftType
deriving (Eq,Ord,Show,Read) | ATTACH AttachType
--deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AttachType
= SCROLLATTACH ScrollAttachType
| AMMOATTACH AmmoAttachType
deriving (Eq, Ord, Show, Read)
data ScrollAttachType
= ZOOMSCOPE
deriving (Eq, Ord, Show, Read)
data AmmoAttachType
= TINMAG
| DRUMMAG
| BULLETBELT
deriving (Eq, Ord, Show, Read)
data ConsumableItemType data ConsumableItemType
= MEDKIT Int = MEDKIT Int
| EXPLOSIVES | EXPLOSIVES
deriving (Eq,Ord,Show,Read) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data EquipItemType data EquipItemType
= MAGSHIELD = MAGSHIELD
@@ -112,16 +130,15 @@ data EquipItemType
| POWERLEGS | POWERLEGS
| SPEEDLEGS | SPEEDLEGS
| JUMPLEGS | JUMPLEGS
| JETPACK | JETPACK
| FUELPACK | FUELPACK
| BULLETBELTPACK | BULLETBELTPACK
| BULLETBELTBRACER | BULLETBELTBRACER
| BATTERYPACK | BATTERYPACK
| AUTODETECTOR Detector | AUTODETECTOR Detector
deriving (Eq,Ord,Show,Read) deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LeftItemType data LeftItemType
= BOOSTER = BOOSTER
@@ -178,15 +195,12 @@ data HeldItemType
| FORCEFIELDGUN | FORCEFIELDGUN
| HELDDETECTOR Detector | HELDDETECTOR Detector
| TORCH | TORCH
| BINOCULARS
| FLATSHIELD | FLATSHIELD
| KEYCARD Int | KEYCARD Int
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItemModuleType data ItemModuleType
= EMPTYMODULE = EMPTYMODULE
| DRUMMAG
| BELTMAG
| MAGNETMAG | MAGNETMAG
| BULPAY BulletSpawn | BULPAY BulletSpawn
| BULBODY BulletEffect | BULBODY BulletEffect
@@ -228,6 +242,9 @@ makeLenses ''ItemModuleType
deriveJSON defaultOptions ''Stack deriveJSON defaultOptions ''Stack
deriveJSON defaultOptions ''CraftType deriveJSON defaultOptions ''CraftType
deriveJSON defaultOptions ''ConsumableItemType deriveJSON defaultOptions ''ConsumableItemType
deriveJSON defaultOptions ''AmmoAttachType
deriveJSON defaultOptions ''ScrollAttachType
deriveJSON defaultOptions ''AttachType
deriveJSON defaultOptions ''Detector deriveJSON defaultOptions ''Detector
deriveJSON defaultOptions ''EquipItemType deriveJSON defaultOptions ''EquipItemType
deriveJSON defaultOptions ''LeftItemType deriveJSON defaultOptions ''LeftItemType
@@ -236,7 +253,7 @@ deriveJSON defaultOptions ''ItemModuleType
deriveJSON defaultOptions ''ModuleSlot deriveJSON defaultOptions ''ModuleSlot
deriveJSON defaultOptions ''ItemBaseType deriveJSON defaultOptions ''ItemBaseType
deriveJSON defaultOptions ''ItemType deriveJSON defaultOptions ''ItemType
instance ToJSONKey ModuleSlot instance ToJSONKey ModuleSlot
instance FromJSONKey ModuleSlot instance FromJSONKey ModuleSlot
-21
View File
@@ -1,21 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.HeldScroll where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Sequence as Seq
data HeldScroll
= HeldScrollDoNothing
| HeldScrollZoom
| HeldScrollCharMode
{_hsCharMode :: Seq.Seq Char}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''HeldScroll
deriveJSON defaultOptions ''HeldScroll
+2 -13
View File
@@ -14,19 +14,8 @@ data Scope
= NoScope = NoScope
| RemoteScope | RemoteScope
{ -- | a camera offset { -- | a camera offset
_scopePos :: Point2 _remotePos :: Point2
, _scopeZoom :: Float , _remoteZoom :: Float
, -- | if the camera offset is also the center of vision
_scopeIsCamera :: Bool
}
| ZoomScope
{ -- | a camera offset
_scopePos :: Point2
-- , _scopeZoomChange :: Int
, _scopeZoom :: Float
, _scopeDefaultZoom :: Float
, -- | if the camera offset is also the center of vision
_scopeIsCamera :: Bool
} }
deriving (Eq, Show, Read) --Generic, Flat) deriving (Eq, Show, Read) --Generic, Flat)
+24 -4
View File
@@ -7,19 +7,18 @@ module Dodge.Data.Item.Use (
module Dodge.Data.Item.Use, module Dodge.Data.Item.Use,
module Dodge.Data.Item.Use.Equipment, module Dodge.Data.Item.Use.Equipment,
module Dodge.Data.Item.HeldUse, module Dodge.Data.Item.HeldUse,
module Dodge.Data.Item.HeldScroll,
module Dodge.Data.Item.HeldDelay, module Dodge.Data.Item.HeldDelay,
module Dodge.Data.Item.Use.Consumption, module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Hammer, module Dodge.Data.Hammer,
module Dodge.Data.Item.Targeting, module Dodge.Data.Item.Targeting,
) where ) where
import Linear import Geometry.Data
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import qualified Data.Sequence as Seq
import Dodge.Data.Hammer import Dodge.Data.Hammer
import Dodge.Data.Item.HeldScroll
import Dodge.Data.Item.HeldUse import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.Use.Consumption import Dodge.Data.Item.Use.Consumption
import Dodge.Data.Item.Use.Equipment import Dodge.Data.Item.Use.Equipment
@@ -33,7 +32,6 @@ data ItemUse
, _heldMods :: HeldMod , _heldMods :: HeldMod
, _heldHammer :: HammerPosition , _heldHammer :: HammerPosition
, _heldAim :: AimParams , _heldAim :: AimParams
, _heldScroll :: HeldScroll
, _heldConsumption :: HeldConsumption , _heldConsumption :: HeldConsumption
-- , _useTargeting :: Maybe TargetType -- , _useTargeting :: Maybe TargetType
} }
@@ -54,8 +52,26 @@ data ItemUse
} }
| CraftUse | CraftUse
{_useAmount :: ItAmount} {_useAmount :: ItAmount}
| AttachUse
{_attachParams :: AttachParams}
--deriving (Eq, Show, Read) --Generic, Flat) --deriving (Eq, Show, Read) --Generic, Flat)
data AttachParams
= ScrollAttachParams {_scrollAttachParams :: ScrollAttachParams}
| AmmoAttachParams
data ScrollAttachParams
= ZoomScrollParams
{ -- | a camera offset
_opticPos :: Point2 -- this should be relative to the camera rotation
-- then when the camera rotates when firing etc,
-- this doesn't need to be changed
, _opticZoom :: Float
, _opticDefaultZoom :: Float
}
| CharScrollParams
{ _scrollChar :: Seq.Seq Char}
data ItemUse' data ItemUse'
= ItemHeld HeldUse' = ItemHeld HeldUse'
| ItemEquip EquipUse' | ItemEquip EquipUse'
@@ -104,8 +120,12 @@ makeLenses ''ItemUse
makeLenses ''AimParams makeLenses ''AimParams
makeLenses ''ItZoom makeLenses ''ItZoom
makeLenses ''Muzzle makeLenses ''Muzzle
makeLenses ''AttachParams
makeLenses ''ScrollAttachParams
deriveJSON defaultOptions ''Muzzle deriveJSON defaultOptions ''Muzzle
deriveJSON defaultOptions ''AimStance deriveJSON defaultOptions ''AimStance
deriveJSON defaultOptions ''ScrollAttachParams
deriveJSON defaultOptions ''AttachParams
deriveJSON defaultOptions ''ItZoom deriveJSON defaultOptions ''ItZoom
deriveJSON defaultOptions ''AimParams deriveJSON defaultOptions ''AimParams
deriveJSON defaultOptions ''ItemUse deriveJSON defaultOptions ''ItemUse
+11 -3
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
@@ -29,6 +29,13 @@ data HeldConsumption
data AmmoSource data AmmoSource
= InternalSource InternalAmmo = InternalSource InternalAmmo
| AboveSource | AboveSource
| BelowSource
| EitherSource
deriving (Eq, Show, Read) --Generic, Flat)
data ExternalSourceType = BulletClip
| BulletBelt
| ElectricPower
deriving (Eq, Show, Read) --Generic, Flat) deriving (Eq, Show, Read) --Generic, Flat)
data InternalAmmo = InternalAmmo data InternalAmmo = InternalAmmo
@@ -54,8 +61,9 @@ data LeftConsumption
deriving (Eq, Show, Read) --Generic, Flat) deriving (Eq, Show, Read) --Generic, Flat)
newtype ItAmount = ItAmount {_getItAmount :: Int} newtype ItAmount = ItAmount {_getItAmount :: Int}
-- deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat) -- deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral) deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
-- deriving stock (Generic) -- deriving stock (Generic)
-- deriving anyclass (Flat) -- deriving anyclass (Flat)
+4 -1
View File
@@ -38,7 +38,7 @@ applyTerminalCommand s = case s of
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
applyTerminalCommandArguments command args u = case command of applyTerminalCommandArguments command args u = case command of
"ITEM" -> fromMaybe u $ do "IT" -> fromMaybe u $ do
(ibt, n) <- parseItem args (ibt, n) <- parseItem args
return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt))) return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt)))
"DEX" -> fromMaybe u $ do "DEX" -> fromMaybe u $ do
@@ -63,6 +63,9 @@ parseItem (x : xs) =
<|> (readMaybe ("EQUIP {_ibtEquip=" ++ x ++ "}") <&> (,parseNum xs)) <|> (readMaybe ("EQUIP {_ibtEquip=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("LEFT {_ibtLEFT=" ++ x ++ "}") <&> (,parseNum xs)) <|> (readMaybe ("LEFT {_ibtLEFT=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("HELD (" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "}") <&> (,1)) <|> (readMaybe ("HELD (" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "}") <&> (,1))
<|> (readMaybe ("ATTACH " ++ x) <&> (,parseNum xs))
<|> (readMaybe ("CONSUMABLE {_ibtConsumable=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("AMMO {_ibtAmmo=" ++ x ++ "}") <&> (,parseNum xs))
<|> parseItem (xs & ix 0 .++~ (x ++ " ")) <|> parseItem (xs & ix 0 .++~ (x ++ " "))
parseItem [] = Nothing parseItem [] = Nothing
+1 -4
View File
@@ -25,10 +25,7 @@ import Geometry
import Picture import Picture
defaultEquipment :: Item defaultEquipment :: Item
defaultEquipment = defaultEquipment = defaultHeldItem & itUse .~ defaultEquipUse
defaultItem
& itInvColor .~ yellow
& itUse .~ defaultEquipUse
defaultFlIt :: FloorItem defaultFlIt :: FloorItem
defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0} defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
+8 -32
View File
@@ -4,7 +4,6 @@ module Dodge.Default.Item (
module Dodge.Default.Item.Effect, module Dodge.Default.Item.Effect,
) where ) where
import Color
import Control.Lens import Control.Lens
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Dodge.Data.Item import Dodge.Data.Item
@@ -19,45 +18,28 @@ defaultItemDimension = ItemDimension
, _dimAttachPos = V3 10 (-5) 3 , _dimAttachPos = V3 10 (-5) 3
} }
defaultItem :: Item defaultHeldItem :: Item
defaultItem = defaultHeldItem = Item
Item
{ _itCurseStatus = Uncursed { _itCurseStatus = Uncursed
, _itType = defaultItemType , _itType = ItemType (HELD PISTOL) mempty
, _itEffect = defaultItEffect , _itEffect = defaultItEffect
, _itID = 0 , _itID = 0
, _itIsHeld = False , _itIsHeld = False
, _itInvColor = yellow
, _itInvSize = 1 , _itInvSize = 1
, _itLocation = InVoid , _itLocation = InVoid
, _itDimension = defaultItemDimension , _itDimension = defaultItemDimension
, _itUse = CraftUse (ItAmount 1) , _itUse = defaultHeldUse
, _itParams = NoParams , _itParams = NoParams
, _itTweaks = NoTweaks , _itTweaks = NoTweaks
, _itScope = NoScope , _itScope = NoScope
-- , _itValue = ItemValue 0 MundaneItem , _itAttachments = mempty
} }
defaultLeftItem :: Item defaultLeftItem :: Item
defaultLeftItem = defaultLeftItem = defaultHeldItem & itUse .~ defaultLeftUse
defaultItem
& itUse .~ defaultLeftUse
& itInvColor .~ cyan
defaultHeldItem :: Item
defaultHeldItem =
defaultItem
& itInvColor .~ white
& itUse .~ defaultHeldUse
defaultCraftItem :: Item defaultCraftItem :: Item
defaultCraftItem = defaultCraftItem = defaultHeldItem & itUse .~ CraftUse 1
defaultItem
& itUse .~ CraftUse 1
& itInvColor .~ green
defaultItemType :: ItemType
defaultItemType = ItemType NoItemType mempty
defaultBulletWeapon :: Item defaultBulletWeapon :: Item
defaultBulletWeapon = defaultBulletWeapon =
@@ -72,7 +54,6 @@ defaultWeapon :: Item
defaultWeapon = defaultWeapon =
defaultHeldItem defaultHeldItem
& itUse .~ defaultHeldUse & itUse .~ defaultHeldUse
& itInvColor .~ white
& itType . iyModules & itType . iyModules
.~ M.fromList .~ M.fromList
[ (ModTarget, EMPTYMODULE) [ (ModTarget, EMPTYMODULE)
@@ -80,10 +61,5 @@ defaultWeapon =
] ]
defaultConsumable :: Item defaultConsumable :: Item
defaultConsumable = defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing 1
defaultItem
& itUse .~ ConsumeUse CDoNothing 1
& itInvColor .~ blue
defaultItZoom :: ItZoom
defaultItZoom = ItZoom 20 0.2 1
-2
View File
@@ -34,7 +34,5 @@ defaultHeldUse =
, _heldMods = HeldModNothing , _heldMods = HeldModNothing
, _heldHammer = HammerUp , _heldHammer = HammerUp
, _heldAim = defaultAimParams , _heldAim = defaultAimParams
, _heldScroll = HeldScrollDoNothing
, _heldConsumption = defaultLoadable , _heldConsumption = defaultLoadable
-- , _useTargeting = Nothing
} }
+12 -4
View File
@@ -9,10 +9,18 @@ defaultAimParams =
{ _aimWeight = 0 { _aimWeight = 0
, _aimTurnSpeed = 1 , _aimTurnSpeed = 1
, _aimRange = 0 , _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1 , _aimZoom = defaultItZoom
, _aimStance = OneHand , _aimStance = OneHand
--, _aimHandlePos = 10 , --, _aimHandlePos = 10
, _aimHandlePos = V2 3 0 _aimHandlePos = V2 3 0
, _aimMuzzles = [Muzzle (V2 20 0) 0 0] , _aimMuzzles = [Muzzle (V2 20 0) 0 0]
-- , _aimMuzPos = 20 -- , _aimMuzPos = 20
}
defaultItZoom :: ItZoom
defaultItZoom =
ItZoom
{ _izMax = 20
, _izMin = 0.2
, _izFac = 1
} }
+68 -25
View File
@@ -1,33 +1,76 @@
module Dodge.HeldScroll ( module Dodge.HeldScroll (
doHeldScroll, doHeldScroll,
canHeldScrollAttach,
) where ) where
--import Dodge.Base.You --import LensHelp hiding ((<|), (|>))
import Control.Lens hiding ((<|), (|>)) --import Data.Maybe
import Data.Sequence --import Control.Monad
import Dodge.Data.Creature --import Geometry
--import Control.Lens hiding ((<|), (|>))
--import Data.Sequence
import Dodge.Data.World import Dodge.Data.World
import Data.Maybe --import SDL (MouseButton (..))
--import LensHelp hiding ((|>), (<|)) --import qualified Data.Map.Strict as M
-- should be able to just import data.item
doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World -- note that scope zooming is controlled by updateScopeZoom
doHeldScroll hs = case hs of doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World
HeldScrollDoNothing -> const . const id doHeldScroll _ _ _ = id
HeldScrollZoom -> const . const id --doHeldScroll invid hs x w = case hs of
HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x -- ZoomScrollParams{}
where -- | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w &
overYourItem f x cr w = fromMaybe w $ do -- cWorld . lWorld . creatures . ix 0 . crInv . ix invid
i <- cr ^? crManipulation . manObject . inInventory . ispItem -- . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr -- ZoomScrollParams{} -> w &
-- cWorld . lWorld . creatures . ix 0 . crInv . ix invid
-- . itUse . attachParams . scrollAttachParams %~ resetscope
--
-- CharScrollParams{} -> w & cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itUse . attachParams . scrollAttachParams . scrollChar %~ cycleSignum x
-- where
-- mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
-- resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
-- resetscope otherAtt = otherAtt
cycleSignum :: Float -> Seq a -> Seq a --doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
cycleSignum x --doScopeZoom scrollamount mp sc = case scrollamount of
| x > 0 = cycleL -- x
| otherwise = cycleR -- | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
-- | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
-- | x > 0 -> zoomInLongGun mp sc
-- | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
-- | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
-- | x < 0 -> zoomOutLongGun sc
-- | otherwise -> sc
--
--zoomSpeed :: Float
--zoomSpeed = 39 / 40
cycleL, cycleR :: Seq a -> Seq a --zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
cycleL (x :<| xs) = xs |> x --zoomInLongGun mousep sc = fromMaybe sc $ do
cycleL xs = xs -- curzoom <- sc ^? opticZoom
cycleR (xs :|> x) = x <| xs -- guard $ curzoom < 8
cycleR xs = xs -- return $
-- sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
-- & opticZoom %~ (/ zoomSpeed)
--
--zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
--zoomOutLongGun sc = fromMaybe sc $ do
-- curzoom <- sc ^? opticZoom
-- guard $ curzoom > 0.5
-- return $
-- sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
-- & opticZoom *~ zoomSpeed
--
--cycleSignum :: Float -> Seq a -> Seq a
--cycleSignum x
-- | x > 0 = cycleL
-- | otherwise = cycleR
--
--cycleL, cycleR :: Seq a -> Seq a
--cycleL (x :<| xs) = xs |> x
--cycleL xs = xs
--cycleR (xs :|> x) = x <| xs
--cycleR xs = xs
--
canHeldScrollAttach :: Item -> ScrollAttachParams -> Bool
canHeldScrollAttach _ _ = True
+39 -37
View File
@@ -1,7 +1,5 @@
module Dodge.HeldUse where module Dodge.HeldUse where
import Dodge.Wall.Move
import Dodge.Wall.ForceField
import Color import Color
import Data.Maybe import Data.Maybe
import Data.Traversable import Data.Traversable
@@ -18,6 +16,8 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.Projectile.Create import Dodge.Projectile.Create
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Tesla.Arc import Dodge.Tesla.Arc
import Dodge.Wall.ForceField
import Dodge.Wall.Move
import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Flash
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
@@ -52,8 +52,8 @@ useMod hm = case hm of
] ]
FlameThrowerMod -> FlameThrowerMod ->
[ withSidePushAfterI 20 [ withSidePushAfterI 20
--, withTempLight 1 100 (V3 1 0 0) , --, withTempLight 1 100 (V3 1 0 0)
, withSidePushI 5 withSidePushI 5
, useAmmoAmount 1 , useAmmoAmount 1
, ammoCheckI , ammoCheckI
] ]
@@ -81,9 +81,12 @@ useMod hm = case hm of
] ]
LasWideMod n -> LasWideMod n ->
[ useAmmoAmount 1 [ useAmmoAmount 1
, withItem $ \it -> duplicateNumBarrels (min , withItem $ \it ->
duplicateNumBarrels
( min
(it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
(it ^?! itParams . lasCycle `div` lasWideRate)) (it ^?! itParams . lasCycle `div` lasWideRate)
)
, withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8 , withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it)) , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withSoundForI tone440sawtoothquietS 2 , withSoundForI tone440sawtoothquietS 2
@@ -114,13 +117,13 @@ useMod hm = case hm of
] ]
ShatterMod -> ShatterMod ->
[ useAmmoAmount 1 [ useAmmoAmount 1
-- , withSoundStart tap3S , -- , withSoundStart tap3S
, useTimeCheck useTimeCheck
, ammoCheckI , ammoCheckI
, blCheck , blCheck
] ]
AmmoCheckMod -> [ammoCheckI] AmmoCheckMod -> [ammoCheckI]
AmmoUseCheckMod -> [useAmmoAmount 1,useTimeCheck, ammoCheckI] AmmoUseCheckMod -> [useAmmoAmount 1, useTimeCheck, ammoCheckI]
AmmoHammerTimeUseOneMod -> AmmoHammerTimeUseOneMod ->
[ useAmmoAmount 1 [ useAmmoAmount 1
, useTimeCheck , useTimeCheck
@@ -128,7 +131,7 @@ useMod hm = case hm of
, blCheck , blCheck
] ]
BangCaneMod -> BangCaneMod ->
[ withMuzFlareI [ withFlare
, withSmoke 1 black 20 200 5 , withSmoke 1 black 20 200 5
, withRecoil , withRecoil
, duplicateLoadedBarrels , duplicateLoadedBarrels
@@ -141,7 +144,7 @@ useMod hm = case hm of
] ]
VolleyGunMod -> VolleyGunMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withTorqueAfter , withTorqueAfter
, useAllAmmo , useAllAmmo
@@ -152,7 +155,7 @@ useMod hm = case hm of
] ]
AutoRifleMod -> AutoRifleMod ->
-- note this is the same as BangCanemMod with the first changed -- note this is the same as BangCanemMod with the first changed
[ withMuzFlareI [ withFlare
, withSmoke 1 black 20 200 5 , withSmoke 1 black 20 200 5
, withRecoil , withRecoil
, duplicateLoadedBarrels , duplicateLoadedBarrels
@@ -164,7 +167,7 @@ useMod hm = case hm of
] ]
BangRodMod -> BangRodMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, withThickSmokeI , withThickSmokeI
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withTorqueAfter , withTorqueAfter
@@ -176,7 +179,7 @@ useMod hm = case hm of
] ]
ElephantGunMod -> ElephantGunMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, withThickSmokeI , withThickSmokeI
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withTorqueAfter , withTorqueAfter
@@ -188,7 +191,7 @@ useMod hm = case hm of
] ]
AutoAmrMod -> AutoAmrMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, withThickSmokeI , withThickSmokeI
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withTorqueAfter , withTorqueAfter
@@ -198,7 +201,7 @@ useMod hm = case hm of
, ammoCheckI -- cf ElephantGun , ammoCheckI -- cf ElephantGun
] ]
MachineGunMod -> MachineGunMod ->
[ withMuzFlareI [ withFlare
, withThinSmokeI , withThinSmokeI
, withSoundStart bangEchoS , withSoundStart bangEchoS
, rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter , rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter
@@ -212,7 +215,7 @@ useMod hm = case hm of
, withSoundItemChoiceStart bangStickSoundChoice , withSoundItemChoiceStart bangStickSoundChoice
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withTorqueAfter , withTorqueAfter
, withMuzFlareI , withFlare
, useTimeCheck , useTimeCheck
, ammoCheckI , ammoCheckI
, blCheck , blCheck
@@ -220,7 +223,7 @@ useMod hm = case hm of
PistolMod -> PistolMod ->
[ withSidePushI 50 [ withSidePushI 50
, withRecoil , withRecoil
, withMuzFlareI , withFlare
, withTorqueAfter , withTorqueAfter
, duplicateLoadedBarrels , duplicateLoadedBarrels
, withSoundStart tap3S , withSoundStart tap3S
@@ -230,7 +233,7 @@ useMod hm = case hm of
, blCheck , blCheck
] ]
AutoPistolMod -> AutoPistolMod ->
[ withMuzFlareI [ withFlare
, withSidePushI 50 , withSidePushI 50
, withRecoil , withRecoil
, withTorqueAfter , withTorqueAfter
@@ -241,7 +244,7 @@ useMod hm = case hm of
, ammoCheckI , ammoCheckI
] ]
MachinePistolMod -> MachinePistolMod ->
[ withMuzFlareI [ withFlare
, withRecoil , withRecoil
, withSidePushI 50 , withSidePushI 50
, withTorqueAfter , withTorqueAfter
@@ -253,7 +256,7 @@ useMod hm = case hm of
] ]
BurstRifleMod -> BurstRifleMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, duplicateLoadedBarrels , duplicateLoadedBarrels
, useAmmoAmount 1 , useAmmoAmount 1
, withSoundStart tap3S , withSoundStart tap3S
@@ -266,7 +269,7 @@ useMod hm = case hm of
] ]
BurstRifleRepeatMod -> BurstRifleRepeatMod ->
[ withRecoil [ withRecoil
, withMuzFlareI , withFlare
, duplicateLoadedBarrels , duplicateLoadedBarrels
, useAmmoAmount 1 , useAmmoAmount 1
, withSoundStart tap3S , withSoundStart tap3S
@@ -274,23 +277,23 @@ useMod hm = case hm of
, ammoCheckI , ammoCheckI
] ]
MiniGunMod i -> MiniGunMod i ->
reverse [ trigDoAlso' (moddelay x) (modcrpos x) useAmmoParams [ duplicateNumBarrels 1
| x <- map ((/ fromIntegral i) . fromIntegral) [1 .. i -1] , repeatTransformed
[ (moddelay x, modcrpos x)
| x <- map ((/ (fromIntegral i - 1)) . fromIntegral) [0 .. i -1]
] ]
<> , afterRecoil (fromIntegral i * 5)
[ afterRecoil (fromIntegral i * 5)
, torqueBefore (fromIntegral i * 0.05) , torqueBefore (fromIntegral i * 0.05)
, withSidePushI (fromIntegral i * 50) , withSidePushI (fromIntegral i * 25)
, useAmmoAmount i , withMuzFlare
, withMuzFlareI
, withSmoke 1 black 20 200 5 , withSmoke 1 black 20 200 5
--, withThinSmokeI , useAmmoAmount i
, withSoundForI mini1S 2 , withSoundForI mini1S 2
, withWarmUp crankSlowS , withWarmUp crankSlowS
, ammoCheckI , ammoCheckI
] ]
SmgMod -> SmgMod ->
[ withMuzFlareI [ withFlare
, withSidePushI 30 , withSidePushI 30
, withRecoil , withRecoil
, withTorqueAfter , withTorqueAfter
@@ -303,23 +306,22 @@ useMod hm = case hm of
RevolverXMod -> RevolverXMod ->
[ withRecoil [ withRecoil
, withTorqueAfter , withTorqueAfter
-- , spreadLoaded , withFlare
, withMuzFlareI
, duplicateLoadedBarrels , duplicateLoadedBarrels
, useAmmoUpTo 1 , useAmmoUpTo 1
, withSoundStart tap3S , withSoundStart tap3S
, repeatOnFrames [2, 4, 6, 8, 10] RevolverXRepeatMod , repeatOnFrames [2, 4, 6, 8, 10] RevolverXRepeatMod
, lockInvFor 10 , lockInvFor 10
-- rather than locking the inventory, a better solution may be to check , -- rather than locking the inventory, a better solution may be to check
-- that the weapon is still in your hands in the repeated frames -- that the weapon is still in your hands in the repeated frames
, useTimeCheck useTimeCheck
, ammoCheckI , ammoCheckI
, blCheck , blCheck
] ]
RevolverXRepeatMod -> RevolverXRepeatMod ->
[ withRecoil [ withRecoil
, withTorqueAfter , withTorqueAfter
, withMuzFlareI , withFlare
, duplicateLoadedBarrels , duplicateLoadedBarrels
, useAmmoUpTo 1 , useAmmoUpTo 1
, withSoundStart tap3S , withSoundStart tap3S
@@ -331,7 +333,7 @@ useMod hm = case hm of
, withRandomOffset , withRandomOffset
, duplicateLoadedBarrels , duplicateLoadedBarrels
, duplicateLoaded , duplicateLoaded
, withMuzFlareI , withMuzFlare
, withRecoil , withRecoil
, withTorqueAfter , withTorqueAfter
, useAllAmmo , useAllAmmo
+7 -7
View File
@@ -4,7 +4,7 @@ module Dodge.Inventory (
rmSelectedInvItem, rmSelectedInvItem,
rmInvItem, rmInvItem,
updateCloseObjects, updateCloseObjects,
closeObjScrollDir, --closeObjScrollDir,
changeSwapSel, changeSwapSel,
scrollAugInvSel, scrollAugInvSel,
crNumFreeSlots, crNumFreeSlots,
@@ -31,7 +31,7 @@ import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import LensHelp import LensHelp
import ListHelp import ListHelp
import Padding --import Padding
-- TODO check what happens to selection index when dropping non-selected items -- TODO check what happens to selection index when dropping non-selected items
@@ -134,11 +134,11 @@ updateCloseObjects w =
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid) updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
closeObjScrollDir :: Float -> World -> World --closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x --closeObjScrollDir x
| x > 0 = over (hud . closeObjects) rotU -- | x > 0 = over (hud . closeObjects) rotU
| x < 0 = over (hud . closeObjects) rotD -- | x < 0 = over (hud . closeObjects) rotD
| otherwise = id -- | otherwise = id
changeSwapSel :: Int -> World -> World changeSwapSel :: Int -> World -> World
changeSwapSel yi w changeSwapSel yi w
+3 -2
View File
@@ -9,6 +9,7 @@ import Dodge.Data.SelectionList
import Dodge.Data.World import Dodge.Data.World
import Dodge.Item.SlotsTaken import Dodge.Item.SlotsTaken
import Dodge.Item.Display import Dodge.Item.Display
import Dodge.Item.InventoryColor
import LensHelp import LensHelp
import Picture.Base import Picture.Base
@@ -26,7 +27,7 @@ invSelectionItem cr i it =
where where
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i) anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i) anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
col = _itInvColor it col = itemInvColor it
(yoff,pics) = case _itCurseStatus it of (yoff,pics) = case _itCurseStatus it of
UndroppableIdentified -> itemDisplayOffset cr it UndroppableIdentified -> itemDisplayOffset cr it
_ -> itemDisplayOffset cr it _ -> itemDisplayOffset cr it
@@ -64,5 +65,5 @@ closeObjectToSelectionItem e =
-- --
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color) closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
closeObjectToTextPictures e = case e of closeObjectToTextPictures e = case e of
Left flit -> let it = _flIt flit in (basicItemDisplay it, _itInvColor it) Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor it)
Right bt -> ([_btText bt], yellow) Right bt -> ([_btText bt], yellow)
+11 -2
View File
@@ -7,6 +7,7 @@ module Dodge.Item (
itemFromBase, itemFromBase,
) where ) where
import Dodge.Item.Ammo
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Item.Consumable import Dodge.Item.Consumable
import Dodge.Item.Craftable import Dodge.Item.Craftable
@@ -16,12 +17,20 @@ import Dodge.Item.Weapon
itemFromBase :: ItemBaseType -> Item itemFromBase :: ItemBaseType -> Item
itemFromBase ibt = case ibt of itemFromBase ibt = case ibt of
NoItemType -> undefined
HELD ht -> itemFromHeldType ht HELD ht -> itemFromHeldType ht
LEFT lt -> itemFromLeftType lt LEFT lt -> itemFromLeftType lt
EQUIP et -> itemFromEquipType et EQUIP et -> itemFromEquipType et
Consumable et -> itemFromConsumableType et CONSUMABLE et -> itemFromConsumableType et
CRAFT cr -> makeTypeCraft cr CRAFT cr -> makeTypeCraft cr
ATTACH at -> itemFromAttachType at
itemFromAttachType :: AttachType -> Item
itemFromAttachType at = case at of
SCROLLATTACH ZOOMSCOPE -> zoomScope
AMMOATTACH DRUMMAG -> drumMag
AMMOATTACH TINMAG -> tinMag
AMMOATTACH BULLETBELT -> beltMag
itemFromConsumableType :: ConsumableItemType -> Item itemFromConsumableType :: ConsumableItemType -> Item
itemFromConsumableType ct = case ct of itemFromConsumableType ct = case ct of
+21
View File
@@ -0,0 +1,21 @@
module Dodge.Item.Ammo where
import Control.Lens
import Dodge.Data.World
import Dodge.Default.Item
tinMag :: Item
tinMag = defaultHeldItem & itType . iyBase .~ ATTACH (AMMOATTACH TINMAG)
& itUse .~ AttachUse AmmoAttachParams
drumMag :: Item
drumMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH DRUMMAG)
beltMag :: Item
beltMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH BULLETBELT)
zoomScope :: Item
zoomScope = tinMag
& itType . iyBase .~ ATTACH (SCROLLATTACH ZOOMSCOPE)
& itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams {_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
+1 -1
View File
@@ -9,7 +9,7 @@ medkit :: Int -> Item
medkit i = medkit i =
defaultConsumable defaultConsumable
& itUse . cUse .~ CHeal i & itUse . cUse .~ CHeal i
& itType . iyBase .~ Consumable (MEDKIT i) & itType . iyBase .~ CONSUMABLE (MEDKIT i)
heal25 :: Int -> World -> Maybe World heal25 :: Int -> World -> Maybe World
heal25 = heal 25 heal25 = heal 25
+5 -22
View File
@@ -1,7 +1,6 @@
module Dodge.Item.Craftable where module Dodge.Item.Craftable where
import Dodge.Default.Item import Dodge.Default.Item
import Color
import Control.Lens import Control.Lens
import Dodge.Data.Item import Dodge.Data.Item
@@ -17,10 +16,7 @@ makeTypeCraft :: CraftType -> Item
makeTypeCraft = makeTypeCraftNum 1 makeTypeCraft = makeTypeCraftNum 1
energyBallCraft :: EnergyBallType -> Item energyBallCraft :: EnergyBallType -> Item
energyBallCraft ebt = energyBallCraft ebt = makeTypeCraft (ENERGYBALLCRAFT ebt) & itInvSize .~ 1
makeTypeCraft (ENERGYBALLCRAFT ebt)
& itInvSize .~ 1
& itInvColor .~ chartreuse
incendiaryModule :: Item incendiaryModule :: Item
incendiaryModule = energyBallCraft IncBall incendiaryModule = energyBallCraft IncBall
@@ -29,34 +25,21 @@ bulletBodyCraft :: BulletEffect -> Item
bulletBodyCraft ebt = bulletBodyCraft ebt =
makeTypeCraft (BULBODYCRAFT ebt) makeTypeCraft (BULBODYCRAFT ebt)
& itInvSize .~ 1 & itInvSize .~ 1
& itInvColor .~ chartreuse
bounceModule :: Item bounceModule :: Item
bounceModule = bulletBodyCraft BounceBullet bounceModule = bulletBodyCraft BounceBullet
teleportModule :: Item teleportModule :: Item
teleportModule = teleportModule = makeTypeCraft TELEPORTMODULE & itInvSize .~ 1
makeTypeCraft TELEPORTMODULE
& itInvSize .~ 1
& itInvColor .~ chartreuse
timeModule :: Item timeModule :: Item
timeModule = timeModule = makeTypeCraft TIMEMODULE & itInvSize .~ 1
makeTypeCraft TIMEMODULE
& itInvSize .~ 1
& itInvColor .~ chartreuse
sizeModule :: Item sizeModule :: Item
sizeModule = sizeModule = makeTypeCraft SIZEMODULE & itInvSize .~ 1
makeTypeCraft SIZEMODULE
& itInvSize .~ 1
& itInvColor .~ chartreuse
gravityModule :: Item gravityModule :: Item
gravityModule = gravityModule = makeTypeCraft GRAVITYMODULE & itInvSize .~ 1
makeTypeCraft GRAVITYMODULE
& itInvSize .~ 1
& itInvColor .~ chartreuse
pipe :: Item pipe :: Item
pipe = makeTypeCraft PIPE pipe = makeTypeCraft PIPE
+27 -21
View File
@@ -2,7 +2,7 @@ module Dodge.Item.Display (
--itemDisplay, --itemDisplay,
itemDisplayOffset, itemDisplayOffset,
canAttachTargetingBelow, canAttachTargetingBelow,
-- selectedItemDisplay, -- selectedItemDisplay,
itemString, itemString,
itemBaseName, itemBaseName,
basicItemDisplay, basicItemDisplay,
@@ -10,21 +10,24 @@ module Dodge.Item.Display (
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Dodge.Item.Info
import Data.Maybe import Data.Maybe
import Dodge.Data.Creature import Dodge.Data.Creature
import Dodge.Item.Info
import Dodge.Item.SlotsTaken import Dodge.Item.SlotsTaken
import Dodge.Module import Dodge.Module
import LensHelp import LensHelp
import Padding import Padding
itemDisplayOffset :: Creature -> Item -> (Int,[String]) itemDisplayOffset :: Creature -> Item -> (Int, [String])
itemDisplayOffset cr itm = case itm ^. itType . iyBase of itemDisplayOffset cr itm = case itm ^. itType . iyBase of
EQUIP (TARGETINGHAT tt) | targetItemCanAttachAbove cr itm
-> (-1, leftPad 15 ' ' (targetingTypeString tt) :
(itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^') )))
EQUIP (TARGETINGHAT tt) EQUIP (TARGETINGHAT tt)
-> (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt))) | targetItemCanAttachAbove cr itm ->
( -1
, leftPad 15 ' ' (targetingTypeString tt) :
(itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^')))
)
EQUIP (TARGETINGHAT tt) ->
(0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
_ -> (0, itemDisplay cr itm) _ -> (0, itemDisplay cr itm)
targetItemCanAttachAbove :: Creature -> Item -> Bool targetItemCanAttachAbove :: Creature -> Item -> Bool
@@ -46,10 +49,9 @@ targetingTypeString tt = case tt of
TargetRBCreature -> "LIFEFORM" TargetRBCreature -> "LIFEFORM"
TargetCursor -> "CURSOR" TargetCursor -> "CURSOR"
itemDisplay :: Creature -> Item -> [String] itemDisplay :: Creature -> Item -> [String]
itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it itemDisplay cr itm =
--itemDisplayWithNumber (showConsumption cr it) it
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm) zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
@@ -57,13 +59,12 @@ zipWithDefaults f g h = go
where where
go [] bs = map g bs go [] bs = map g bs
go as [] = map f as go as [] = map f as
go (a:as) (b:bs) = h a b : go as bs go (a : as) (b : bs) = h a b : go as bs
itemDisplayPad :: [Char] -> String -> [Char] itemDisplayPad :: [Char] -> String -> [Char]
itemDisplayPad ls rs itemDisplayPad ls rs
| rs == "" = ls | rs == "" = ls
| otherwise = midPadL 15 ' ' ls (' ':rs) | otherwise = midPadL 15 ' ' ls (' ' : rs)
basicItemDisplay :: Item -> [String] basicItemDisplay :: Item -> [String]
basicItemDisplay itm = basicItemDisplay itm =
@@ -78,14 +79,14 @@ itemString = head . basicItemDisplay
itemBaseName :: Item -> String itemBaseName :: Item -> String
itemBaseName it = case _iyBase $ _itType it of itemBaseName it = case _iyBase $ _itType it of
NoItemType -> show "NoItemType"
CRAFT str -> show str CRAFT str -> show str
HELD hit -> case hit ^? xNum of HELD hit -> case hit ^? xNum of
Just i -> takeWhile (/= ' ') (show hit) ++ show i Just i -> takeWhile (/= ' ') (show hit) ++ show i
Nothing -> show hit Nothing -> show hit
LEFT lit -> show lit LEFT lit -> show lit
EQUIP eit -> showEquipItem eit EQUIP eit -> showEquipItem eit
Consumable cit -> show cit CONSUMABLE cit -> show cit
ATTACH ait -> show ait
showEquipItem :: EquipItemType -> String showEquipItem :: EquipItemType -> String
showEquipItem eit = case eit of showEquipItem eit = case eit of
@@ -118,15 +119,18 @@ itemNumberDisplay cr itm = case iu of
HeldUse{} -> [showReloadProgress cr itm] HeldUse{} -> [showReloadProgress cr itm]
LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)] LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)]
EquipUse{} -> showEquipmentNumber cr itm EquipUse{} -> showEquipmentNumber cr itm
_ -> [show $ iu ^?! useAmount . getItAmount] CraftUse x -> [show $ x ^. getItAmount]
ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
AttachUse {} -> []
where where
iu = itm ^?! itUse iu = itm ^?! itUse
showEquipmentNumber :: Creature -> Item -> [String] showEquipmentNumber :: Creature -> Item -> [String]
showEquipmentNumber cr itm = case _eeUse ee of showEquipmentNumber cr itm = case _eeUse ee of
EFuelSource x _ -> [show x] EFuelSource x _ -> [show x]
EAmmoSource {} -> showAmmoSource cr itm EAmmoSource{} -> showAmmoSource cr itm
EBatterySource {_euseBatteryAmount = x} -> [show x] EBatterySource{_euseBatteryAmount = x} -> [show x]
_ -> [""] _ -> [""]
where where
ee = itm ^?! itUse . equipEffect ee = itm ^?! itUse . equipEffect
@@ -137,18 +141,20 @@ showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
atype <- eu ^? euseAmmoSourceType atype <- eu ^? euseAmmoSourceType
x <- fmap showIntKMG' $ eu ^? euseAmmoAmount x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
i <- itm ^? itLocation . ipInvID i <- itm ^? itLocation . ipInvID
(do ( do
at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
guard (at' == atype && as == AboveSource) guard (at' == atype && as == AboveSource)
return ["vvvv",x] ) <|> Just [x] return ["vvvv", x]
)
<|> Just [x]
showReloadProgress :: Creature -> Item -> String showReloadProgress :: Creature -> Item -> String
showReloadProgress cr itm = case ic ^? laSource of showReloadProgress cr itm = case ic ^? laSource of
Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of
Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded
Just la -> showLoadActionType la (_laSource ic) Just la -> showLoadActionType la (_laSource ic)
Just AboveSource -> fromMaybe "||||" $ do Just AboveSource -> fromMaybe "^^^^" $ do
i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
_ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount _ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
return "" return ""
+2 -4
View File
@@ -18,12 +18,12 @@ import ShapePicture
itemSPic :: Item -> SPic itemSPic :: Item -> SPic
itemSPic it = itemSPic it =
M.foldMapWithKey (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of M.foldMapWithKey (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of
NoItemType -> over _1 (colorSH magenta) defSPic
CRAFT _ -> defSPic CRAFT _ -> defSPic
HELD ht -> heldItemSPic ht it HELD ht -> heldItemSPic ht it
LEFT lt -> leftItemSPic lt it LEFT lt -> leftItemSPic lt it
EQUIP et -> equipItemSPic et it EQUIP et -> equipItemSPic et it
Consumable{} -> defSPic CONSUMABLE{} -> defSPic
ATTACH {} -> defSPic
equipItemSPic :: EquipItemType -> Item -> SPic equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of equipItemSPic et _ = case et of
@@ -112,7 +112,6 @@ ammoPosition itm hit = case hit of
SHATTERGUN -> NoAmmoPosition SHATTERGUN -> NoAmmoPosition
HELDDETECTOR _ -> NoAmmoPosition HELDDETECTOR _ -> NoAmmoPosition
KEYCARD _ -> NoAmmoPosition KEYCARD _ -> NoAmmoPosition
BINOCULARS -> NoAmmoPosition
where where
lhs = Q.axisAngle (V3 1 0 0) pi lhs = Q.axisAngle (V3 1 0 0) pi
rhs = Q.axisAngle (V3 1 0 0) 0 rhs = Q.axisAngle (V3 1 0 0) 0
@@ -186,7 +185,6 @@ heldItemSPic ht it = case ht of
SHATTERGUN -> shatterGunSPic SHATTERGUN -> shatterGunSPic
HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2) HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic) KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)
BINOCULARS -> mempty -- TODO
torchShape :: Shape torchShape :: Shape
torchShape = torchShape =
+2 -6
View File
@@ -127,14 +127,10 @@ powerLegs =
& itType . iyBase .~ EQUIP POWERLEGS & itType . iyBase .~ EQUIP POWERLEGS
speedLegs :: Item speedLegs :: Item
speedLegs = speedLegs = powerLegs & itType . iyBase .~ EQUIP SPEEDLEGS
powerLegs
& itType . iyBase .~ EQUIP SPEEDLEGS
jumpLegs :: Item jumpLegs :: Item
jumpLegs = jumpLegs = powerLegs & itType . iyBase .~ EQUIP JUMPLEGS
powerLegs
& itType . iyBase .~ EQUIP JUMPLEGS
wristInvisibility :: Item wristInvisibility :: Item
wristInvisibility = wristInvisibility =
-1
View File
@@ -26,7 +26,6 @@ itemFromHeldType :: HeldItemType -> Item
itemFromHeldType ht = case ht of itemFromHeldType ht = case ht of
KEYCARD i -> keyCard i KEYCARD i -> keyCard i
TORCH -> torch TORCH -> torch
BINOCULARS -> binoculars
SHATTERGUN -> shatterGun SHATTERGUN -> shatterGun
BANGSTICK i -> bangStick i BANGSTICK i -> bangStick i
PISTOL -> pistol PISTOL -> pistol
+9 -29
View File
@@ -39,25 +39,14 @@ defaultBangCane =
volleyGun :: Int -> Item volleyGun :: Int -> Item
volleyGun i = volleyGun i =
defaultBangCane defaultBangCane
& itUse . heldDelay . rateMax .~ 6
& itUse . heldMods .~ VolleyGunMod & itUse . heldMods .~ VolleyGunMod
& itUse . heldAim . aimWeight .~ 6 & itUse . heldAim . aimWeight .~ 6
& itUse . heldAim . aimRange .~ 1 & itUse . heldAim . aimRange .~ 1
& itUse . heldAim . aimStance .~ TwoHandFlat & itUse . heldAim . aimStance .~ TwoHandFlat
& itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5} & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-- & itUse . heldAim . aimHandlePos .~ 5
& itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3] & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 3]
& itUse . heldConsumption . laSource . _InternalSource . iaMax .~ i & itUse . heldConsumption . laSource . _InternalSource . iaMax .~ i
& itParams & itParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
.~ BulletShooter
{ _muzVel = 0.8
, _rifling = 0.9
, _bore = 2
, _recoil = 50
, _torqueAfter = 0.1
, _randomOffset = 0
}
& itParams . torqueAfter .~ 0.48 + 0.2 * fromIntegral i
& itType . iyBase .~ HELD (VOLLEYGUN i) & itType . iyBase .~ HELD (VOLLEYGUN i)
rifle :: Item rifle :: Item
@@ -66,7 +55,8 @@ rifle =
& itUse . heldAim . aimStance .~ TwoHandUnder & itUse . heldAim . aimStance .~ TwoHandUnder
& itType . iyBase .~ HELD RIFLE & itType . iyBase .~ HELD RIFLE
& itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 1 & itUse . heldConsumption . laSource . _InternalSource . iaMax .~ 1
& itUse . heldConsumption . laSource . _InternalSource . iaCycle .~ [loadEject 5, loadInsert 5, loadPrime 5] & itUse . heldConsumption . laSource . _InternalSource . iaCycle
.~ [loadEject 5, loadInsert 5, loadPrime 5]
& itUse . heldAim . aimWeight .~ 6 & itUse . heldAim . aimWeight .~ 6
& itUse . heldAim . aimRange .~ 1 & itUse . heldAim . aimRange .~ 1
& itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5} & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
@@ -107,30 +97,20 @@ miniGunUse i =
& heldAim . aimRange .~ 1 & heldAim . aimRange .~ 1
& heldAim . aimStance .~ TwoHandUnder & heldAim . aimStance .~ TwoHandUnder
& heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5} & heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-- & heldAim . aimHandlePos .~ 5
& heldConsumption & heldConsumption
.~ (defaultBulletLoadable & laSource .~ AboveSource) .~ (defaultBulletLoadable & laSource .~ AboveSource)
--(defaultBulletLoadable -- & heldConsumption . laSource . _InternalSource . iaCycle
-- & laSource . iaMax .~ 1500 -- .~ [loadEject 40, loadInsert 40, loadPrime 40]
-- & laSource . iaLoaded .~ 1500
--)
& heldConsumption . laSource . _InternalSource . iaCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
miniGunX :: Int -> Item miniGunX :: Int -> Item
miniGunX i = miniGunX i =
autoRifle autoRifle
& itUse .~ miniGunUse i & itUse .~ miniGunUse i
& itUse . heldAim . aimTurnSpeed .~ 0.5 & itUse . heldAim . aimTurnSpeed .~ 0.5
& itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 15 0) 0 0.05) & itUse . heldAim . aimMuzzles .~ replicate i (Muzzle (V2 30 0) 0 0.05)
& itParams & itParams . recoil .~ 10
.~ BulletShooter & itParams . torqueAfter .~ 0.01
{ _muzVel = 1 & itParams . randomOffset .~ 10
, _rifling = 0.9
, _bore = 2
, _recoil = 10
, _torqueAfter = 0
, _randomOffset = 10
}
& itInvSize .~ fromIntegral i + 1 & itInvSize .~ fromIntegral i + 1
& itDimension . dimRad .~ 20 & itDimension . dimRad .~ 20
& itDimension . dimCenter .~ V3 5 0 0 & itDimension . dimCenter .~ V3 5 0 0
+1 -1
View File
@@ -59,7 +59,7 @@ remoteLauncher =
launcher launcher
& itType . iyBase .~ HELD REMOTELAUNCHER & itType . iyBase .~ HELD REMOTELAUNCHER
& itUse . heldUse .~ HeldFireRemoteShell --fireRemoteShell & itUse . heldUse .~ HeldFireRemoteShell --fireRemoteShell
& itScope .~ RemoteScope (V2 0 0) 1 True & itScope .~ RemoteScope (V2 0 0) 1
& itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell & itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
basicAmPjMoves :: IM.IntMap TweakParam basicAmPjMoves :: IM.IntMap TweakParam
+2 -4
View File
@@ -49,7 +49,6 @@ elephantGun =
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0.05 & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0.05
& itUse . heldMods .~ ElephantGunMod & itUse . heldMods .~ ElephantGunMod
& itParams . recoil .~ 50 & itParams . recoil .~ 50
& itParams . torqueAfter .~ 0.1
amr :: Item amr :: Item
amr = amr =
@@ -69,9 +68,8 @@ sniperRifle =
& itType . iyBase .~ HELD SNIPERRIFLE & itType . iyBase .~ HELD SNIPERRIFLE
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0 & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5,_izFac = 1} & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5,_izFac = 1}
& itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun -- & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
& itScope .~ ZoomScope (V2 0 0) 1 0.5 False -- & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
& itType . iyModules . at ModTarget ?~ TARGET TargetLaser
-- & itUse . useTargeting ?~ TargetLaser -- & itUse . useTargeting ?~ TargetLaser
machineGun :: Item machineGun :: Item
+2 -20
View File
@@ -2,7 +2,6 @@ module Dodge.Item.Held.Utility where
import Linear import Linear
import Dodge.Default.Item import Dodge.Default.Item
import Color
import Control.Lens import Control.Lens
import Dodge.Data.Item import Dodge.Data.Item
--import Geometry.Data --import Geometry.Data
@@ -19,27 +18,10 @@ flatShield =
& itType . iyBase .~ HELD FLATSHIELD & itType . iyBase .~ HELD FLATSHIELD
keyCard :: Int -> Item keyCard :: Int -> Item
keyCard n = keyCard n = defaultHeldItem & itType . iyBase .~ HELD (KEYCARD n)
defaultHeldItem
& itInvColor .~ aquamarine
& itType . iyBase .~ HELD (KEYCARD n)
latchkey :: Int -> Item latchkey :: Int -> Item
latchkey _ = latchkey _ = defaultHeldItem
defaultHeldItem
& itInvColor .~ yellow
binoculars :: Item
binoculars =
defaultHeldItem
& itScope .~ ZoomScope (V2 0 0) 1 0.5 False
& itType . iyBase .~ HELD BINOCULARS
-- & itUse . heldAim . aimHandlePos .~ 5
-- & itUse . heldAim . aimMuzPos .~ 10
& itUse . heldAim . aimStance .~ TwoHandFlat
& itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
& itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5, _izFac = 1}
torch :: Item torch :: Item
torch = torch =
+6 -2
View File
@@ -1,4 +1,8 @@
module Dodge.Item.HeldOffset where module Dodge.Item.HeldOffset (
turretItemOffset,
twoFlatHRot,
heldItemOffset,
) where
import Data.Maybe import Data.Maybe
import Dodge.Creature.HandPos import Dodge.Creature.HandPos
@@ -66,4 +70,4 @@ strideRot cr = case cr ^? crStance . carriage of
sLen = _strideLength $ _crStance cr sLen = _strideLength $ _crStance cr
twoFlatHRot :: Creature -> Float twoFlatHRot :: Creature -> Float
twoFlatHRot cr = 2 * strideRot cr twoFlatHRot = (2 *) . strideRot
+2 -3
View File
@@ -23,7 +23,7 @@ itmBaseInfo itm = case itm ^. itType . iyBase of
HELD hit -> heldInfo hit HELD hit -> heldInfo hit
LEFT lit -> leftInfo lit LEFT lit -> leftInfo lit
EQUIP eit -> equipInfo eit EQUIP eit -> equipInfo eit
Consumable cit -> consumableInfo cit CONSUMABLE cit -> consumableInfo cit
CRAFT fit -> craftInfo fit CRAFT fit -> craftInfo fit
_ -> "THIS SHOULD NOT BE DISPLAYED" _ -> "THIS SHOULD NOT BE DISPLAYED"
@@ -105,7 +105,6 @@ heldInfo hit = case hit of
FORCEFIELDGUN -> "A device that produces a durable forcefield." FORCEFIELDGUN -> "A device that produces a durable forcefield."
HELDDETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius." HELDDETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
TORCH -> "A stick with a light on the end." TORCH -> "A stick with a light on the end."
BINOCULARS -> "Two cylinders with lenses. Scroll to zoom."
FLATSHIELD -> "A panel of metal that blocks unwanted objects from the front of the user." FLATSHIELD -> "A panel of metal that blocks unwanted objects from the front of the user."
KEYCARD i -> "A keycard. It is labelled " ++ show i ++ "." KEYCARD i -> "A keycard. It is labelled " ++ show i ++ "."
@@ -222,7 +221,7 @@ itmUsageInfo itm = case itm ^. itType . iyBase of
"This item can be equipped" ++ itmEquipSiteInfo itm "This item can be equipped" ++ itmEquipSiteInfo itm
++ ". When equipped, it can be activated." ++ ". When equipped, it can be activated."
EQUIP _ -> "This item can be equipped " ++ itmEquipSiteInfo itm ++ "." EQUIP _ -> "This item can be equipped " ++ itmEquipSiteInfo itm ++ "."
Consumable _ -> "This item can be consumed." CONSUMABLE _ -> "This item can be consumed."
CRAFT _ -> "" CRAFT _ -> ""
_ -> "THIS SHOULD NOT BE DISPLAYED" _ -> "THIS SHOULD NOT BE DISPLAYED"
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Item.InventoryColor where
import Color
import Dodge.Data.Item
import Control.Lens
itemInvColor :: Item -> Color
itemInvColor itm = case itm ^. itType . iyBase of
HELD {} -> white
LEFT {} -> cyan
EQUIP {} -> yellow
CONSUMABLE {} -> blue
CRAFT {} -> green
ATTACH {} -> orange
+7
View File
@@ -2,9 +2,11 @@ module Dodge.Item.Location (
pointerToItemLocation, pointerToItemLocation,
getItem, getItem,
pointerToItem, pointerToItem,
pointerYourItem,
) where ) where
import Control.Lens import Control.Lens
import Data.Maybe
import Dodge.Data.World import Dodge.Data.World
getItem :: Int -> World -> Maybe Item getItem :: Int -> World -> Maybe Item
@@ -26,6 +28,11 @@ pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid .
pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt
pointerToItemLocation _ = const pure pointerToItemLocation _ = const pure
pointerYourItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
Just $ pointerToItemLocation (InInv 0 itinvid) f w
pointerToItem :: pointerToItem ::
Applicative f => Applicative f =>
Item -> Item ->
-1
View File
@@ -70,7 +70,6 @@ heldBounds hit = case hit of
FORCEFIELDGUN -> launchs FORCEFIELDGUN -> launchs
HELDDETECTOR _ -> launchs HELDDETECTOR _ -> launchs
TORCH -> launchs TORCH -> launchs
BINOCULARS -> launchs
FLATSHIELD -> launchs FLATSHIELD -> launchs
KEYCARD _ -> launchs KEYCARD _ -> launchs
where where
+1 -14
View File
@@ -1,29 +1,16 @@
module Dodge.Item.Weapon.Remote ( module Dodge.Item.Weapon.Remote (
setRemoteScope, setRemoteScope,
setRemoteBombScope,
) where ) where
import Control.Lens import Control.Lens
import Dodge.Data.World import Dodge.Data.World
import Dodge.Default
import Geometry import Geometry
setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w = case w ^?! cWorld . lWorld . itemLocations . ix itid of
InInv cid invid ->
w
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itScope
. scopePos
.~ (_prPos pj -.- (w ^?! cWorld . lWorld . creatures . ix cid . crPos))
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom
.~ (defaultItZoom{_izMax = 0.5, _izMin = 0.5})
_ -> w
setRemoteScope :: Int -> Point2 -> World -> World setRemoteScope :: Int -> Point2 -> World -> World
setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of
Just (InInv cid' invid) -> Just (InInv cid' invid) ->
w w
& cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope & cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope
. scopePos . remotePos
.~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos)) .~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos))
_ -> w _ -> w
+68 -20
View File
@@ -8,12 +8,12 @@ module Dodge.Item.Weapon.TriggerType (
useAllAmmo, useAllAmmo,
useAmmoUpTo, useAmmoUpTo,
lockInvFor, lockInvFor,
withMuzFlareI, withFlare,
withMuzFlare,
withCrPos, withCrPos,
withCrPosShift, withCrPosShift,
withOldDir, withOldDir,
trigDoAlso, trigDoAlso,
trigDoAlso',
withTempLight, withTempLight,
withItem, withItem,
withItemUpdate, withItemUpdate,
@@ -57,6 +57,7 @@ module Dodge.Item.Weapon.TriggerType (
ammoCheckI, ammoCheckI,
modClock, modClock,
blCheck, blCheck,
repeatTransformed,
) where ) where
import Dodge.Creature.HandPos import Dodge.Creature.HandPos
@@ -89,18 +90,25 @@ lockInvFor i f it cr =
f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr))) f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
. lockInv (_crID cr) . lockInv (_crID cr)
trigDoAlso' :: repeatTransformed ::
[(Item -> Item,Creature -> Creature)] ->
ChainEffect
repeatTransformed xs f itm cr w = foldr g w xs
where
g (fit,fcr) = f (fit itm) (fcr cr)
trigDoAlso ::
(Item -> Item) -> (Item -> Item) ->
(Creature -> Creature) -> (Creature -> Creature) ->
(Item -> Creature -> World -> World) -> (Item -> Creature -> World -> World) ->
ChainEffect ChainEffect
trigDoAlso' fit fcr f g itm cr = g itm cr . f (fit itm) (fcr cr) trigDoAlso fit fcr f g itm cr = g itm cr . f (fit itm) (fcr cr)
-- Note that this uses the "base" creature and item values -- Note that this uses the "base" creature and item values
trigDoAlso :: --trigDoAlso ::
(Item -> Creature -> World -> World) -> -- (Item -> Creature -> World -> World) ->
ChainEffect -- ChainEffect
trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr --trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr
withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect
withSmoke num col rad t alt eff item cr w = withSmoke num col rad t alt eff item cr w =
@@ -202,16 +210,16 @@ withWarmUp ::
withWarmUp soundID f item cr w withWarmUp soundID f item cr w
| curWarmUp < maxWarmUp && crWeaponReady cr = | curWarmUp < maxWarmUp && crWeaponReady cr =
w w
& pointerToItem . itUse . heldDelay . warmTime +~ 2 & pointertoitem . itUse . heldDelay . warmTime +~ 2
& soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2) & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
| otherwise = | otherwise =
w w
& pointerToItem . itUse . heldDelay . warmTime .~ maxWarmUp & pointertoitem . itUse . heldDelay . warmTime .~ maxWarmUp
& f item cr & f item cr
where where
cid = _crID cr cid = _crID cr
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef pointertoitem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _heldDelay $ _itUse item curWarmUp = _warmTime . _heldDelay $ _itUse item
maxWarmUp = _warmMax . _heldDelay $ _itUse item maxWarmUp = _warmMax . _heldDelay $ _itUse item
@@ -352,7 +360,7 @@ useAmmoUpTo amAmount eff item cr =
useAmmoAmount :: Int -> ChainEffect useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = useAmmoAmount amAmount eff item cr =
eff item cr eff item cr
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ useAmmoAmount' itref amAmount) -- . _InternalSource . iaLoaded -~ amAmount) . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ useAmmoAmount' itref amAmount)
where where
itref = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change itref = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
@@ -362,6 +370,12 @@ useAmmoAmount' itref x inv = case inv ^? ix itref . itUse . heldConsumption . la
inv & ix itref . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ x inv & ix itref . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ x
Just AboveSource -> Just AboveSource ->
inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
Just BelowSource ->
inv & ix (itref + 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
Just EitherSource -> case inv ^? ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount of
Just amamount | amamount > 0 ->
inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
_ -> inv & ix (itref + 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
_ -> inv _ -> inv
-- . crInv . ix itRef . itUse . heldConsumption . laSource -- . crInv . ix itRef . itUse . heldConsumption . laSource
@@ -411,7 +425,7 @@ shootL ::
World World
shootL f item cr w shootL f item cr w
| fireCondition = | fireCondition =
f item cr w & pointerToItem f item cr w & cWorld . lWorld . creatures . ix cid . crInv . ix invid
%~ ( itUseCharge 1 %~ ( itUseCharge 1
. (itUse . leftDelay . rateTime .~ _rateMax (_leftDelay (_itUse item))) . (itUse . leftDelay . rateTime .~ _rateMax (_leftDelay (_itUse item)))
) )
@@ -420,7 +434,6 @@ shootL f item cr w
where where
cid = _crID cr cid = _crID cr
invid = _ipInvID $ _itLocation item invid = _ipInvID $ _itLocation item
pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix invid
fireCondition = fireCondition =
_rateTime (_leftDelay (_itUse item)) == 0 _rateTime (_leftDelay (_itUse item)) == 0
&& _arLoaded (_leftConsumption (_itUse item)) > 0 && _arLoaded (_leftConsumption (_itUse item)) > 0
@@ -453,8 +466,8 @@ modClock n chainEff eff it cr w
| (w ^. cWorld . lWorld . lClock) `mod` n == 0 = chainEff eff it cr w | (w ^. cWorld . lWorld . lClock) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w | otherwise = eff it cr w
withMuzFlareI :: ChainEffect withFlare :: ChainEffect
withMuzFlareI f it cr = withFlare f it cr =
makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (cpos `v2z` 20) makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (cpos `v2z` 20)
-- . muzFlareAt (V4 5 5 0 2) (cpos `v2z` 20) cdir -- . muzFlareAt (V4 5 5 0 2) (cpos `v2z` 20) cdir
. muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir . muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
@@ -465,6 +478,19 @@ withMuzFlareI f it cr =
cdir = _crDir cr cdir = _crDir cr
cpos = _crPos cr cpos = _crPos cr
withMuzFlare :: ChainEffect
withMuzFlare f itm cr =
makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (cpos `v2z` 20)
-- . muzFlareAt (V4 5 5 0 2) (cpos `v2z` 20) cdir
. muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
. muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
. muzFlareAt (V4 10 10 1 3) (cpos `v2z` 20) cdir
. f itm cr
where
cdir = _crDir cr
cpos = _crPos cr + rotateV (_crDir cr) (_mzPos brl + aimingWeaponZeroPos cr itm)
brl = itm ^?! itUse . heldAim . aimMuzzles . ix 0
--muzzleOffset :: Creature -> Item -> Point3 --muzzleOffset :: Creature -> Item -> Point3
--muzzleOffset cr it = V3 (holdOffset + 5 + _aimMuzPos dimPort - _aimHandlePos dimPort) 0 0 --muzzleOffset cr it = V3 (holdOffset + 5 + _aimMuzPos dimPort - _aimHandlePos dimPort) 0 0
-- where -- where
@@ -554,10 +580,14 @@ torqueBefore torque feff item cr w
& randGen .~ g & randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot & cWorld . lWorld . creatures . ix cid . crDir +~ rot
& wCam . camRot +~ rot & wCam . camRot +~ rot
& rotateScope
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where where
cid = _crID cr cid = _crID cr
(rot, g) = randomR (- torque, torque) $ _randGen w (rot, g) = randomR (- torque, torque) $ _randGen w
rotateScope = fromMaybe id $ do
i <- yourScopeInvID w
return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
{- | Rotates a creature with minimum rotation {- | Rotates a creature with minimum rotation
Rotates the player creature before applying the effect, other creatures after. Rotates the player creature before applying the effect, other creatures after.
@@ -575,6 +605,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
& randGen .~ g & randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot' & cWorld . lWorld . creatures . ix cid . crDir +~ rot'
& wCam . camRot +~ rot' & wCam . camRot +~ rot'
& rotateScope
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
where where
cid = _crID cr cid = _crID cr
@@ -582,17 +613,31 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
rot' rot'
| rot < 0 = rot - minTorque | rot < 0 = rot - minTorque
| otherwise = rot + minTorque | otherwise = rot + minTorque
rotateScope = fromMaybe id $ do
i <- yourScopeInvID w
return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
-- | Rotate a randomly creature after applying an effect. -- | Rotate a randomly creature after applying an effect.
withTorqueAfter :: ChainEffect withTorqueAfter :: ChainEffect
withTorqueAfter feff item cr w withTorqueAfter feff item cr w
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w -- | cid == 0 = rotateScope . set randGen g $ over (wCam . camRot) (+ rot) $ feff item cr w
| cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) $ feff item cr w -- | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w | cid == 0 = w
& feff item cr
& wCam . camRot +~ rot
& rotateScope
& randGen .~ g
| otherwise = w
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& randGen .~ g
where where
cid = _crID cr cid = _crID cr
(rot, g) = randomR (- torque, torque) $ _randGen w (rot, g) = randomR (- torque, torque) $ _randGen w
torque = fromMaybe 0 $ item ^? itParams . torqueAfter torque = fromMaybe 0 $ item ^? itParams . torqueAfter
rotateScope = fromMaybe id $ do
i <- yourScopeInvID w
return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
-- rotateScope = pointerYourItem . itScope . scopePos %~ rotateV rot
sideEffectOnFrame :: sideEffectOnFrame ::
Int -> Int ->
@@ -604,11 +649,14 @@ sideEffectOnFrame i sf f it cr w =
torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect :: Float -> Item -> Creature -> World -> World
torqueSideEffect torque _ cr w torqueSideEffect torque _ cr w
| cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w | cid == 0 = set randGen g . rotateScope $ over (wCam . camRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where where
cid = _crID cr cid = _crID cr
(rot, g) = randomR (- torque, torque) $ _randGen w (rot, g) = randomR (- torque, torque) $ _randGen w
rotateScope = fromMaybe id $ do
i <- yourScopeInvID w
return $ cWorld . lWorld . creatures . ix cid . crInv . ix i . itUse . attachParams . scrollAttachParams . opticPos %~ rotateV rot
-- pump the updated creature into the chain in later frames -- pump the updated creature into the chain in later frames
repeatOnFrames :: [Int] -> HeldMod -> ChainEffect repeatOnFrames :: [Int] -> HeldMod -> ChainEffect
+1 -4
View File
@@ -10,7 +10,6 @@ module Dodge.Item.Weapon.Utility
import Control.Lens import Control.Lens
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Default import Dodge.Default
import Picture
stopWatch :: Item stopWatch :: Item
stopWatch = stopWatch =
@@ -20,7 +19,6 @@ stopWatch =
& leftUse .~ LTimePause & leftUse .~ LTimePause
& equipEffect . eeSite .~ GoesOnWrist & equipEffect . eeSite .~ GoesOnWrist
) )
& itInvColor .~ cyan
& itEffect . ieInv .~ ChargeIfEquipped & itEffect . ieInv .~ ChargeIfEquipped
& itEffect . ieOnDrop .~ SetCharge 0 & itEffect . ieOnDrop .~ SetCharge 0
& itType . iyBase .~ LEFT STOPWATCH & itType . iyBase .~ LEFT STOPWATCH
@@ -53,8 +51,7 @@ shrinkGun =
blinkGun :: Item blinkGun :: Item
blinkGun = blinkGun =
defaultLeftItem defaultLeftItem
{ _itInvColor = cyan { _itUse =
, _itUse =
defaultLeftUse defaultLeftUse
& leftUse .~ LBlink --hammerCheckL (shootL $ const blinkAction) & leftUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
& equipEffect . eeSite .~ GoesOnWrist & equipEffect . eeSite .~ GoesOnWrist
+1 -2
View File
@@ -22,8 +22,7 @@ moduleStrings = M.elems . M.mapMaybe moduleName . _iyModules . _itType
moduleName :: ItemModuleType -> Maybe String moduleName :: ItemModuleType -> Maybe String
moduleName imt = case imt of moduleName imt = case imt of
EMPTYMODULE -> Nothing EMPTYMODULE -> Nothing
DRUMMAG -> Just "+DRUM MAG" -- BELTMAG -> Just "+BELT FEED"
BELTMAG -> Just "+BELT FEED"
MAGNETMAG -> Just "+MAGNET FEED" MAGNETMAG -> Just "+MAGNET FEED"
BULPAY thepayload -> Just $ "+" ++ displayBulletPayload thepayload BULPAY thepayload -> Just $ "+" ++ displayBulletPayload thepayload
BULBODY thebody -> Just $ "+" ++ displayBulletBody thebody BULBODY thebody -> Just $ "+" ++ displayBulletBody thebody
+1 -1
View File
@@ -83,7 +83,7 @@ retireRemoteProj :: Int -> Int -> World -> World
retireRemoteProj itid pjid w = retireRemoteProj itid pjid w =
w w
& pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid)
%~ ( (itScope . scopePos .~ V2 0 0) %~ ( (itScope . remotePos .~ V2 0 0)
. (itUse . heldUse .~ HeldFireRemoteShell) . (itUse . heldUse .~ HeldFireRemoteShell)
) )
& cWorld . lWorld . props %~ IM.delete pjid & cWorld . lWorld . props %~ IM.delete pjid
+2
View File
@@ -365,7 +365,9 @@ doDrawing' win pdata u = do
-- draw the overlay -- draw the overlay
--glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO) --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO)
glDepthFunc GL_ALWAYS glDepthFunc GL_ALWAYS
--glDepthFunc GL_GEQUAL
glDepthMask GL_FALSE glDepthMask GL_FALSE
--glDepthMask GL_TRUE
glEnable GL_BLEND glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
renderLayer DebugLayer shadV layerCounts renderLayer DebugLayer shadV layerCounts
+11
View File
@@ -50,6 +50,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures = concatMap f . getShownItems makeSelectionListPictures = concatMap f . getShownItems
where where
f si = map (color (_siColor si) . text) $ _siPictures si f si = map (color (_siColor si) . text) $ _siPictures si
--f si = map ((flip inverseText) ((_siColor si))) $ _siPictures si
drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
drawCursorAt mi lis ldps = fromMaybe mempty $ do drawCursorAt mi lis ldps = fromMaybe mempty $ do
@@ -159,6 +160,16 @@ drawListElement ygap s xint yint =
renderListAt :: Float -> Float -> [(String, Color)] -> Picture renderListAt :: Float -> Float -> [(String, Color)] -> Picture
renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str) renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
--inverseText :: String -> Color -> Picture
--inverseText str col =
-- translate3 (V3 0 0 (0.5))
-- (color (V4 0 1 0 0.1) ( text str))
-- <>
-- translate3 (V3 0 0 (0.4))
-- (color col (polygon [0,V2 l 0, V2 l 200, V2 0 200]))
-- where
-- l = 100 * fromIntegral (length str)
-- given a list of pictures that are each the size of a "text" call, displays them as -- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen -- a list on the screen
drawList :: [Picture] -> Picture drawList :: [Picture] -> Picture
+36 -35
View File
@@ -6,6 +6,7 @@ module Dodge.Update.Camera (
) where ) where
import Bound import Bound
import Control.Applicative
import Control.Monad import Control.Monad
import Data.Foldable import Data.Foldable
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@@ -57,9 +58,7 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
& camViewFrom +~ thetran & camViewFrom +~ thetran
translateFloatingCameraKeys :: Input -> Camera -> Camera translateFloatingCameraKeys :: Input -> Camera -> Camera
translateFloatingCameraKeys theinput = translateFloatingCameraKeys theinput = (camCenter -~ thetran) . (camViewFrom -~ thetran)
(camCenter -~ thetran)
. (camViewFrom -~ thetran)
where where
thetran = 10 *.* wasdDir theinput thetran = 10 *.* wasdDir theinput
@@ -87,33 +86,31 @@ moveZoomCamera cfig theinput cr campos =
& camDefaultZoom .~ newDefaultZoom & camDefaultZoom .~ newDefaultZoom
& camItemZoom .~ newItemZoom & camItemZoom .~ newItemZoom
where where
cpos = _crPos cr newvf = _crPos cr +.+ fromMaybe (V2 0 0) vfoffset
mitm = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
cr ^? crInv . ix i
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do vfoffset = do
iscam <- mitm ^? _Just . itScope . scopeIsCamera
guard iscam
guard (SDL.ButtonRight `M.member` _mouseButtons theinput) guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
mitm ^? _Just . itScope . scopePos i <- cr ^? crManipulation . manObject . inInventory . ispItem
(cr ^? crInv . ix i . itScope . remotePos)
mscopeoffset = do mscopeoffset = do
guard (SDL.ButtonRight `M.member` _mouseButtons theinput) guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
mitm ^? _Just . itScope . scopePos i <- cr ^? crManipulation . manObject . inInventory . ispItem
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticPos)
<|> (cr ^? crInv . ix i . itScope . remotePos)
newcen = _crPos cr +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = offset =
rotateV (campos ^. camRot) $ rotateV (campos ^. camRot) $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = case mitm ^? _Just . itScope of newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
Just zs@ZoomScope{} -> _scopeZoom zs i <- cr ^? crManipulation . manObject . inInventory . ispItem
_ -> newDefaultZoom * newItemZoom (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom)
idealDefaultZoom = clipZoom wallZoom idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = case mitm ^? _Just . itScope of newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do
Just zs@ZoomScope{} -> _scopeZoom zs i <- cr ^? crManipulation . manObject . inInventory . ispItem
_ -> changeZoom (campos ^. camDefaultZoom) idealDefaultZoom (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom)
idealItemZoom = fromMaybe 1 $ do idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming cr guard $ crIsAiming cr
zoomFromItem <$> (mitm ^? _Just . itUse . heldAim . aimZoom) i <- cr ^? crManipulation . manObject . inInventory . ispItem
zoomFromItem <$> (cr ^? crInv . ix i . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom newItemZoom = changeZoom (campos ^. camItemZoom) idealItemZoom
changeZoom curZoom idealZoom changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
@@ -129,9 +126,11 @@ moveZoomCamera cfig theinput cr campos =
zoomInSpeed = 25 zoomInSpeed = 25
zoomOutSpeed = 15 zoomOutSpeed = 15
-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
updateScopeZoom :: World -> World updateScopeZoom :: World -> World
updateScopeZoom w = fromMaybe w $ do updateScopeZoom w = fromMaybe w $ do
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem i <- yourScopeInvID w
return $ updateScopeZoom' i w return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World updateScopeZoom' :: Int -> World -> World
@@ -140,12 +139,12 @@ updateScopeZoom' i w
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
| otherwise = w & wppointer %~ resetscope | otherwise = w & wppointer %~ resetscope
where where
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . attachParams . scrollAttachParams
resetscope (ZoomScope _ _ defz bl) = ZoomScope (V2 0 0) defz defz bl resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
resetscope otherAtt = otherAtt resetscope otherAtt = otherAtt
mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w) mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
doScopeZoom :: Int -> Point2 -> Scope -> Scope doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
doScopeZoom scrollamount mp sc = case scrollamount of doScopeZoom scrollamount mp sc = case scrollamount of
x x
| x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
@@ -159,21 +158,21 @@ doScopeZoom scrollamount mp sc = case scrollamount of
zoomSpeed :: Float zoomSpeed :: Float
zoomSpeed = 39 / 40 zoomSpeed = 39 / 40
zoomInLongGun :: Point2 -> Scope -> Scope zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
zoomInLongGun mousep sc = fromMaybe sc $ do zoomInLongGun mousep sc = fromMaybe sc $ do
curzoom <- sc ^? scopeZoom curzoom <- sc ^? opticZoom
guard $ curzoom < 8 guard $ curzoom < 8
return $ return $
sc & scopePos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
& scopeZoom %~ (/ zoomSpeed) & opticZoom %~ (/ zoomSpeed)
zoomOutLongGun :: Scope -> Scope zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
zoomOutLongGun sc = fromMaybe sc $ do zoomOutLongGun sc = fromMaybe sc $ do
curzoom <- sc ^? scopeZoom curzoom <- sc ^? opticZoom
guard $ curzoom > 0.5 guard $ curzoom > 0.5
return $ return $
sc & scopePos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p) sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
& scopeZoom *~ zoomSpeed & opticZoom *~ zoomSpeed
ifConfigWallRotate :: Configuration -> World -> World ifConfigWallRotate :: Configuration -> World -> World
ifConfigWallRotate cfig w ifConfigWallRotate cfig w
@@ -212,9 +211,11 @@ rotateCameraBy x w =
rotateanyscope = fromMaybe id $ do rotateanyscope = fromMaybe id $ do
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
return $ return $
lWorld . creatures . ix 0 . crInv . ix i lWorld . creatures . ix 0 . crInv . ix (i - 1)
. itScope . itUse
. scopePos . attachParams
. scrollAttachParams
. opticPos
%~ rotateV x %~ rotateV x
rotateCamera :: Configuration -> World -> World rotateCamera :: Configuration -> World -> World
+4 -4
View File
@@ -26,10 +26,10 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
-- functions that modify the inventory should be centralised so that -- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps -- this lock can be sensibly applied, perhaps
| w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of | rbDown -> case (yourScrollAttachment w, _rbOptions w) of
(_, EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax (_,EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
(Nothing, _) -> closeObjScrollDir y w (Nothing, _) -> w
(Just f, _) -> doHeldScroll f y (you w) w (Just (invid,hs), _) -> doHeldScroll invid hs y w
| lbDown -> w & wCam . camZoom +~ y | lbDown -> w & wCam . camZoom +~ y
| invKeyDown -> changeSwapSel yi w | invKeyDown -> changeSwapSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w