From 210787d2dc613e5d9f6730c27ec0456264b74f7d Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 23 Dec 2023 15:14:02 +0000 Subject: [PATCH] Broken commit --- src/Dodge/Creature/State.hs | 3 ++ src/Dodge/Data/Item/Combine.hs | 26 +++++++++------- src/Dodge/Data/Item/Use.hs | 4 ++- src/Dodge/Debug/Terminal.hs | 3 ++ src/Dodge/HeldScroll.hs | 51 ++++++++++++++++++++++++++++++-- src/Dodge/Item.hs | 13 +++----- src/Dodge/Item/Ammo.hs | 8 ++--- src/Dodge/Item/Display.hs | 1 - src/Dodge/Item/Draw/SPic.hs | 1 - src/Dodge/Item/Held/Rod.hs | 2 +- src/Dodge/Item/InventoryColor.hs | 3 +- src/Dodge/Item/Weapon/Remote.hs | 1 - src/Dodge/Render.hs | 2 ++ src/Dodge/Render/List.hs | 11 +++++++ src/Dodge/Update/Camera.hs | 16 ++++++---- 15 files changed, 107 insertions(+), 38 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 47b1a4b87..df6d41508 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -271,6 +271,9 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of | l < m -> it & itUse . leftConsumption . arProgress -~ 1 _ -> 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 cr = do i <- cr ^? crManipulation . manObject . inInventory . ispItem diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index d93d878e4..06d2a82b4 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -87,7 +87,6 @@ data ItemBaseType = HELD {_ibtHeld :: HeldItemType} | LEFT {_ibtLeft :: LeftItemType} | EQUIP {_ibtEquip :: EquipItemType} - | AMMO {_ibtAmmo :: AmmoItemType} | CONSUMABLE {_ibtConsumable :: ConsumableItemType} | CRAFT CraftType | ATTACH AttachType @@ -96,11 +95,21 @@ data ItemBaseType --deriving (Eq, Ord, Show, Read) --Generic, Flat) data AttachType - = ZOOMSCOPE - | TINMAG - | DRUMMAG + = 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 = MEDKIT Int | EXPLOSIVES @@ -191,12 +200,6 @@ data HeldItemType | KEYCARD Int deriving (Eq, Ord, Show, Read) --Generic, Flat) -data AmmoItemType - = TINMAGAZINE - | DRUMMAGAZINE - | BULLETBELT - deriving (Eq, Ord, Show, Read) --Generic, Flat) - data ItemModuleType = EMPTYMODULE | MAGNETMAG @@ -240,12 +243,13 @@ makeLenses ''ItemModuleType deriveJSON defaultOptions ''Stack deriveJSON defaultOptions ''CraftType deriveJSON defaultOptions ''ConsumableItemType +deriveJSON defaultOptions ''AmmoAttachType +deriveJSON defaultOptions ''ScrollAttachType deriveJSON defaultOptions ''AttachType deriveJSON defaultOptions ''Detector deriveJSON defaultOptions ''EquipItemType deriveJSON defaultOptions ''LeftItemType deriveJSON defaultOptions ''HeldItemType -deriveJSON defaultOptions ''AmmoItemType deriveJSON defaultOptions ''ItemModuleType deriveJSON defaultOptions ''ModuleSlot deriveJSON defaultOptions ''ItemBaseType diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 412f721c1..56114b98d 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -63,7 +63,9 @@ data AttachParams data ScrollAttachParams = ZoomScrollParams { -- | a camera offset - _opticPos :: Point2 + _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 -- , _scopeZoomChange :: Int , _opticZoom :: Float , _opticDefaultZoom :: Float diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index e37d0812c..2ad9d4660 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -63,6 +63,9 @@ parseItem (x : xs) = <|> (readMaybe ("EQUIP {_ibtEquip=" ++ x ++ "}") <&> (,parseNum xs)) <|> (readMaybe ("LEFT {_ibtLEFT=" ++ x ++ "}") <&> (,parseNum xs)) <|> (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 [] = Nothing diff --git a/src/Dodge/HeldScroll.hs b/src/Dodge/HeldScroll.hs index 944568a73..1635b6107 100644 --- a/src/Dodge/HeldScroll.hs +++ b/src/Dodge/HeldScroll.hs @@ -3,14 +3,61 @@ module Dodge.HeldScroll ( canHeldScrollAttach, ) where -import Control.Lens hiding ((<|), (|>)) +import LensHelp hiding ((<|), (|>)) +import Data.Maybe +import Control.Monad +import Geometry +--import Control.Lens hiding ((<|), (|>)) import Data.Sequence import Dodge.Data.World +import SDL (MouseButton (..)) +import qualified Data.Map.Strict as M doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World doHeldScroll invid hs x w = case hs of - ZoomScrollParams{}-> w + ZoomScrollParams{} + | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w & + cWorld . lWorld . creatures . ix 0 . crInv . ix invid + . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp + 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 + +doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams +doScopeZoom scrollamount mp sc = case scrollamount of + x + | 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 + +zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams +zoomInLongGun mousep sc = fromMaybe sc $ do + curzoom <- sc ^? opticZoom + guard $ curzoom < 8 + 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 diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 1676099c5..b49dceb01 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -20,22 +20,17 @@ itemFromBase ibt = case ibt of HELD ht -> itemFromHeldType ht LEFT lt -> itemFromLeftType lt EQUIP et -> itemFromEquipType et - AMMO at -> itemFromAmmoType at CONSUMABLE et -> itemFromConsumableType et CRAFT cr -> makeTypeCraft cr ATTACH at -> itemFromAttachType at itemFromAttachType :: AttachType -> Item itemFromAttachType at = case at of - ZOOMSCOPE -> zoomScope - DRUMMAG -> drumMag - TINMAG -> tinMag + SCROLLATTACH ZOOMSCOPE -> zoomScope + AMMOATTACH DRUMMAG -> drumMag + AMMOATTACH TINMAG -> tinMag + AMMOATTACH BULLETBELT -> beltMag -itemFromAmmoType :: AmmoItemType -> Item -itemFromAmmoType at = case at of - TINMAGAZINE -> tinMag - DRUMMAGAZINE -> drumMag - BULLETBELT -> beltMag itemFromConsumableType :: ConsumableItemType -> Item itemFromConsumableType ct = case ct of diff --git a/src/Dodge/Item/Ammo.hs b/src/Dodge/Item/Ammo.hs index 3b62ab83e..3b1d22916 100644 --- a/src/Dodge/Item/Ammo.hs +++ b/src/Dodge/Item/Ammo.hs @@ -5,17 +5,17 @@ import Dodge.Data.World import Dodge.Default.Item tinMag :: Item -tinMag = defaultHeldItem & itType . iyBase .~ AMMO TINMAGAZINE +tinMag = defaultHeldItem & itType . iyBase .~ ATTACH (AMMOATTACH TINMAG) & itUse .~ AttachUse AmmoAttachParams drumMag :: Item -drumMag = tinMag & itType . iyBase .~ AMMO DRUMMAGAZINE +drumMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH DRUMMAG) beltMag :: Item -beltMag = tinMag & itType . iyBase .~ AMMO BULLETBELT +beltMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH BULLETBELT) zoomScope :: Item zoomScope = tinMag - & itType . iyBase .~ ATTACH ZOOMSCOPE + & itType . iyBase .~ ATTACH (SCROLLATTACH ZOOMSCOPE) & itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams {_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5})) diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 93131ea3c..9e1e97de1 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -85,7 +85,6 @@ itemBaseName it = case _iyBase $ _itType it of Nothing -> show hit LEFT lit -> show lit EQUIP eit -> showEquipItem eit - AMMO ait -> show ait CONSUMABLE cit -> show cit ATTACH ait -> show ait diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index d660bf517..f9f1dfd9d 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -22,7 +22,6 @@ itemSPic it = HELD ht -> heldItemSPic ht it LEFT lt -> leftItemSPic lt it EQUIP et -> equipItemSPic et it - AMMO {} -> defSPic CONSUMABLE{} -> defSPic ATTACH {} -> defSPic diff --git a/src/Dodge/Item/Held/Rod.hs b/src/Dodge/Item/Held/Rod.hs index bd40ab2da..dc1dbfdf7 100644 --- a/src/Dodge/Item/Held/Rod.hs +++ b/src/Dodge/Item/Held/Rod.hs @@ -74,7 +74,7 @@ sniperRifle = -- , _scopeZoom = 1 -- , _scopeDefaultZoom = 0.5 -- } - & itType . iyModules . at ModTarget ?~ TARGET TargetLaser +-- & itType . iyModules . at ModTarget ?~ TARGET TargetLaser -- & itUse . useTargeting ?~ TargetLaser machineGun :: Item diff --git a/src/Dodge/Item/InventoryColor.hs b/src/Dodge/Item/InventoryColor.hs index 06c513a9a..aaa020eed 100644 --- a/src/Dodge/Item/InventoryColor.hs +++ b/src/Dodge/Item/InventoryColor.hs @@ -9,7 +9,6 @@ itemInvColor itm = case itm ^. itType . iyBase of HELD {} -> white LEFT {} -> cyan EQUIP {} -> yellow - AMMO {} -> orange CONSUMABLE {} -> blue CRAFT {} -> green - ATTACH {} -> chartreuse + ATTACH {} -> orange diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs index fa7d277d9..02d674ff4 100644 --- a/src/Dodge/Item/Weapon/Remote.hs +++ b/src/Dodge/Item/Weapon/Remote.hs @@ -7,7 +7,6 @@ import Dodge.Data.World import Dodge.Default import Geometry - setRemoteScope :: Int -> Point2 -> World -> World setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of Just (InInv cid' invid) -> diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index f0c2a08e1..f525fa484 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -365,7 +365,9 @@ doDrawing' win pdata u = do -- draw the overlay --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO) glDepthFunc GL_ALWAYS + --glDepthFunc GL_GEQUAL glDepthMask GL_FALSE + --glDepthMask GL_TRUE glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA renderLayer DebugLayer shadV layerCounts diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index a5735fdba..53cdff76e 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -50,6 +50,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures = concatMap f . getShownItems where 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 mi lis ldps = fromMaybe mempty $ do @@ -159,6 +160,16 @@ drawListElement ygap s xint yint = renderListAt :: Float -> Float -> [(String, Color)] -> Picture 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 -- a list on the screen drawList :: [Picture] -> Picture diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 31eca8bf6..84941b8cd 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -6,6 +6,7 @@ module Dodge.Update.Camera ( ) where import Bound +import Control.Applicative import Control.Monad import Data.Foldable import qualified Data.Map.Strict as M @@ -75,7 +76,7 @@ updateInGameCamera cfig w = & updateBounds cfig & over wCam (setViewDistance cfig) & wCam %~ moveZoomCamera cfig (w ^. input) (you w) - & updateScopeZoom +-- & updateScopeZoom & rotateCamera cfig moveZoomCamera :: Configuration -> Input -> Creature -> Camera -> Camera @@ -97,14 +98,19 @@ moveZoomCamera cfig theinput cr campos = mitm ^? _Just . itScope . remotePos mscopeoffset = do guard (SDL.ButtonRight `M.member` _mouseButtons theinput) - mitm ^? _Just . itScope . remotePos + i <- cr ^? crManipulation . manObject . inInventory . ispItem + (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticPos) + <|> (mitm ^? _Just . itScope . remotePos) newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset offset = rotateV (campos ^. camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput - newzoom = case mitm ^? _Just . itScope of --- Just zs@ZoomScope{} -> _scopeZoom zs - _ -> newDefaultZoom * newItemZoom + newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do + i <- cr ^? crManipulation . manObject . inInventory . ispItem + (cr ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams . opticZoom) +-- case mitm ^? _Just . itScope of +---- Just zs@ZoomScope{} -> _scopeZoom zs +-- _ -> newDefaultZoom * newItemZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = case mitm ^? _Just . itScope of -- Just zs@ZoomScope{} -> _scopeZoom zs