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

Add newtype for item id int

Browse Source
This commit is contained in:
justin
2024-09-28 23:34:32 +01:00
parent 241191ee1b
commit 7d72fa3c5d
14 changed files with 274 additions and 267 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+6 -6
View File
@@ -1,12 +1,12 @@
/home/justin/Haskell/loop/src/Dodge/Item/Display.hs:(109,28)-(121,21): warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: TargetingUse _ _ _
|
109 | itemNumberDisplay cr itm = case iu of
| ^^^^^^^^^^...
/home/justin/Haskell/loop/src/Dodge/Creature/Impulse/UseItem.hs:(36,22)-(46,19): warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: TargetingUse _ _ _
|
36 | itemEffect cr it w = case it ^. ldtValue . itUse of
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/home/justin/Haskell/loop/src/Dodge/Item/Display.hs:(109,28)-(121,21): warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: TargetingUse _ _ _
|
109 | itemNumberDisplay cr itm = case iu of
| ^^^^^^^^^^...
src/Dodge/Data/Item.hs
+2 -1
View File
@@ -16,6 +16,7 @@ module Dodge.Data.Item (
module Dodge.Data.Item.Location,
) where
import NewInt
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -36,7 +37,7 @@ data ItID = ItID
data Item = Item
{ _itUse :: ItemUse
, _itType :: ItemType
, _itID :: Int
, _itID :: NewInt ItmInt
, _itLocation :: ItemLocation
, _itEffect :: ItEffect
, _itInvSize :: Float
src/Dodge/Data/Item/Location.hs
+4
View File
@@ -21,6 +21,8 @@ data TurretInt
deriving (Eq,Ord,Show,Read)
data CrInt = CrInt
deriving (Eq,Ord,Show,Read)
data ItmInt = ItmInt
deriving (Eq,Ord,Show,Read)
data ItemLocation
= InInv
@@ -39,3 +41,5 @@ makeLenses ''ItemLocation
deriveJSON defaultOptions ''InvInt
deriveJSON defaultOptions ''FloorInt
deriveJSON defaultOptions ''ItemLocation
deriveJSON defaultOptions ''ItmInt
deriveJSON defaultOptions ''CrInt
src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+5 -3
View File
@@ -9,6 +9,8 @@ module Dodge.Data.Item.Use.Consumption.Ammo (
module Dodge.Data.Payload,
) where
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -21,11 +23,11 @@ data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProject
data ProjectileUpdate
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: Maybe Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: Maybe (NewInt ItmInt)}
| ReduceSpinPU {_pjuReduceSpin :: Float}
| DestroyPU {_pjuScreenID :: Maybe Int, _pjuTimer :: Int}
| DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt), _pjuTimer :: Int}
| TimePU
| CollisionEffectPU {_pjuScreenID :: Maybe Int}
| CollisionEffectPU {_pjuScreenID :: Maybe (NewInt ItmInt)}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data AmmoType
src/Dodge/Data/World.hs
+4 -3
View File
@@ -13,6 +13,7 @@ module Dodge.Data.World (
module Dodge.Data.Input,
) where
import NewInt
import Control.Lens
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
@@ -62,7 +63,7 @@ data TimeFlowStatus
{ _scrollSmoothing :: Int
, _reverseAmount :: Int
, _futureWorlds :: [LWorld]
, _scrollItemLocation :: Int
, _scrollItemID :: NewInt ItmInt
}
| CameraScrollTimeFlow
{ _scrollSmoothing :: Int
@@ -71,11 +72,11 @@ data TimeFlowStatus
}
| RewindLeftClick
{ _reverseAmount :: Int
, _scrollItemLocation :: Int
, _scrollItemID :: NewInt ItmInt
}
| PausedTimeFlow
{ _timeFlowCharge :: Int
, _scrollItemLocation :: Int
, _scrollItemID :: NewInt ItmInt
}
makeLenses ''TimeFlowStatus
src/Dodge/FloorItem.hs
+1 -1
View File
@@ -23,7 +23,7 @@ copyItemToFloorID pos it w =
(,) (NInt flid) $
w'
& cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
& cWorld . lWorld . itemLocations %~ IM.insert (_itID it) (OnFloor $ NInt flid)
& cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid)
where
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w
src/Dodge/Inventory.hs
+1 -1
View File
@@ -47,7 +47,7 @@ destroyInvItem ::
destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
where
removeitloc = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
-- | after this the item at the inventory position will no longer exist
src/Dodge/Inventory/Add.hs
+2 -2
View File
@@ -48,7 +48,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
-- not sure if the following is necessary
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it)
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
.~ InInv
{_ilCrID = cid
, _ilInvID = invid
@@ -82,7 +82,7 @@ createItemYou itm w = fromMaybe (OnFloor flid, w') $ do
where
itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
(flid,w') = copyItemToFloorID pos (itm & itID .~ itid) w
(flid,w') = copyItemToFloorID pos (itm & itID .~ NInt itid) w
-- | Pick up a specific item.
src/Dodge/Inventory/Location.hs
+2 -1
View File
@@ -6,6 +6,7 @@ module Dodge.Inventory.Location
)
where
import NewInt
import qualified Data.IntSet as IS
import Dodge.Base.You
import Dodge.Data.SelectionList
@@ -55,7 +56,7 @@ crUpdateInvidLocations mo crid lw invid itm = lw
& creatures . ix crid . crInv . ix invid . itLocation .~ newloc
& itemLocations %~ IM.insert itid newloc
where
itid = itm ^. itID
itid = itm ^. itID . unNInt
newloc = InInv
{ _ilCrID = crid
, _ilInvID = invid
src/Dodge/Item/Location/Initialize.hs
+3 -3
View File
@@ -40,7 +40,7 @@ initCrItemLocations w cr = (w', cr & crInv .~ newinv)
-- does not worry about creature manipulation for now
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ locid
,it & itID .~ NInt locid
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. itemLocations)
@@ -55,7 +55,7 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
, flit & flIt . itID .~ locid
, flit & flIt . itID .~ NInt locid
& flIt . itLocation .~ loc
)
where
@@ -69,6 +69,6 @@ initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc)
in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
, mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc
)
src/Dodge/Luse.hs
+3 -3
View File
@@ -25,7 +25,7 @@ useStopWatch :: Item -> Creature -> World -> World
useStopWatch itm _ w = w
& timeFlow .~ PausedTimeFlow
{ _timeFlowCharge = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemLocation = _itID itm
, _scrollItemID = _itID itm
}
@@ -34,7 +34,7 @@ useTimeScrollGun itm _ w = w & timeFlow .~ ItemScrollTimeFlow
{ _scrollSmoothing = 0
, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _futureWorlds = []
, _scrollItemLocation = _itID itm
, _scrollItemID = _itID itm
}
@@ -42,7 +42,7 @@ useRewindGun :: Item -> Creature -> World -> World
useRewindGun itm _ w = w
& timeFlow .~ RewindLeftClick
{ _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemLocation = _itID itm
, _scrollItemID = _itID itm
}
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
src/Dodge/Projectile/Update.hs
+7 -6
View File
@@ -3,6 +3,7 @@ module Dodge.Projectile.Update
( updateProjectile
) where
import NewInt
import Dodge.Payload
import Control.Lens
import Data.Maybe
@@ -42,7 +43,7 @@ upProjectile pu pj = case pu of
time = _prjTimer pj
act st et = time <= st && time >= et
shellCollisionEffect :: Maybe Int -> Projectile -> World -> World
shellCollisionEffect :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
shellCollisionEffect mscreenid = shellCollisionCheck
$ \pj -> explodeShell mscreenid (_prjID pj)
@@ -57,12 +58,12 @@ shellCollisionCheck f pj w
oldPos = _prjPos pj
newPos = oldPos +.+ _prjVel pj
destroyProjectile :: Maybe Int -> Int -> World -> World
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
destroyProjectile mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete pjid
& removelink
where
removelink = fromMaybe id $ do
itid <- mitid
itid <- fmap _unNInt mitid
loc <- w ^? cWorld . lWorld . itemLocations . ix itid
itm <- w ^? pointerToItemLocation loc . itUse . atLinkedProjectile . _Just
guard $ itm == pjid
@@ -107,9 +108,9 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
spinFactor = 5 * (6 - fromIntegral i)
-- note this only allows YOU to remotely track projectiles
pjRemoteSetDirection :: Maybe Int -> Projectile -> World -> World
pjRemoteSetDirection :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
screenid <- mscreenid
screenid <- fmap _unNInt mscreenid
let newdir
| w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
@@ -133,7 +134,7 @@ decTimMvVel pj =
vel = _prjVel pj
pjid = _prjID pj
explodeShell :: Maybe Int -> Int -> World -> World
explodeShell :: Maybe (NewInt ItmInt) -> Int -> World -> World
explodeShell mitid pjid w =
w
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
src/Dodge/Update.hs
+6 -5
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import NewInt
import Control.Monad
import Dodge.Update.Input.InGame
import Dodge.Update.Input.ScreenLayer
@@ -168,14 +169,14 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
DeathTime{} -> u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
pauseTime :: Int -> World -> World
pauseTime :: NewInt ItmInt -> World -> World
pauseTime itmloc w
| justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
| otherwise = w & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge -~ 1
| otherwise = w & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge -~ 1
where
justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just 0
outofcharge = maybe True (== 0) charge
charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge
charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge
doItemTimeScroll :: Int -> World -> World
doItemTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of
@@ -206,7 +207,7 @@ scrollTimeBack w = case w ^? pastWorlds . _head of
_ -> w
where
mupdateitem x = fromMaybe id $ do
i <- w ^? timeFlow . scrollItemLocation
i <- w ^? timeFlow . scrollItemID . unNInt
let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
return $ (pointituse . leftConsumption . wpCharge .~ (x -1))
. ( pointituse . leftHammer .~ HammerDown)
@@ -223,7 +224,7 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
where
ramount = (w ^?! timeFlow . reverseAmount) + 1
mupdateitem = fromMaybe id $ do
i <- w ^? timeFlow . scrollItemLocation
i <- w ^? timeFlow . scrollItemID . unNInt
return $ pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
-- | The update step.
tags
+228 -232
View File
File diff suppressed because it is too large Load Diff