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

Cleanup

Browse Source
This commit is contained in:
justin
2022-07-27 12:49:23 +01:00
parent 6554d219dc
commit 8d17ce66e9
106 changed files with 2911 additions and 2678 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/WinScale.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Base.WinScale where
import Dodge.Config.Data
import Dodge.Data.Config
import Geometry
import Picture
@@ -8,4 +9,4 @@ winScale :: Configuration -> Picture -> Picture
winScale cfig = scale (2 / _windowX cfig) (2 / _windowY cfig)
doWindowScale :: Configuration -> Point2 -> Point2
doWindowScale cfig (V2 x y) = V2 ( x * 2 / _windowX cfig) ( y * 2 / _windowY cfig)
doWindowScale cfig (V2 x y) = V2 (x * 2 / _windowX cfig) (y * 2 / _windowY cfig)
src/Dodge/Beam.hs
+1 -1
View File
@@ -40,7 +40,7 @@ splitBeamCombine (p,(a,b,_),(x,y,_))
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
= w' & pointToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
= w' & pointerToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
where
itid = fromJust $ _bmOrigin bm
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
src/Dodge/Bullet.hs
+109 -87
View File
@@ -1,40 +1,70 @@
module Dodge.Bullet
( updateBullet
, useAmmoParams
) where
import Dodge.MagnetBuBu
import qualified ListHelp as List
import Dodge.EnergyBall
module Dodge.Bullet (
updateBullet,
useAmmoParams,
) where
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Creature.HandPos
import Dodge.Base.Coordinate
import Dodge.EnergyBall
import Dodge.MagnetBuBu
import Dodge.Movement.Turn
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import qualified ListHelp as List
import StreamingHelp
import qualified IntMapHelp as IM
import Data.Maybe
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
updateBullet w bu = case _buDelayFraction bu of
1 -> mvBullet 1 w bu
x -> mvBullet x w (bu & buDelayFraction .~ 1)
updateBullet :: World -> Bullet -> (World,Maybe Bullet)
updateBullet w bu = case _buState bu of
DelayedBullet x -> mvBullet x w bu
_ -> mvBullet 1 w bu
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBullet x w bu
| _buTimer bu <= 0 || magV (_buVel bu) < 1 = (endspawn w, Nothing)
| otherwise =
second (fmap updateBulVel)
. hitEffFromBul x w
$ applyMagnetsToBul bu w
where
endspawn = fromMaybe id $ do
partspawn <- bulletSpawn bu
return $ partspawn p
p = _buPos bu
applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu =
foldr (\mg -> doMagnetBuBu (_mgField mg) mg) bu . _magnets . _cWorld
updateBulVel :: Bullet -> Bullet
updateBulVel bt = case _buTrajectory bt of
BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
MagnetTrajectory tpos -> bt & buVel %~ (clipV 20 . (+.+ 5 *.* normalizeV (tpos -.- _buPos bt)))
FlechetteTrajectory tpos -> bt & buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
BezierTrajectory spos tpos xpos ->
let bf tm = bQuadToF (spos, xpos, tpos) $ (100 - tm) * 0.05
in bt & buVel .~ bf (fromIntegral $ t - 1) -.- bf (fromIntegral t)
where
t = _buTimer bt
useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
& buPos .~ sp
& buTrajectory %~ settrajectory
& buVel %~ (rotateV dir . (muzvel *.*))
& buDrag *~ _rifling (_itParams it)
)
useAmmoParams it cr w =
w & cWorld . instantBullets
.:~ ( _amBullet bultype
& buPos .~ sp
& buTrajectory %~ settrajectory
& buVel %~ (rotateV dir . (muzvel *.*))
& buDrag *~ _rifling (_itParams it)
)
where
sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
dir = _crDir cr
bultype = _laAmmoType $ _itConsumption it
bultype = _laAmmoType $ _heldConsumption $ _itUse it
muzvel = _muzVel $ _itParams it
muzlength = aimingMuzzlePos cr it
settrajectory traj = case traj of
@@ -49,35 +79,9 @@ useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
tpos <- it ^? itTargeting . tgPos . _Just
return $ BezierTrajectory sp tpos (mouseWorldPos w)
{- Update for a generic bullet. -}
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBullet x w bt'
| t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
| otherwise = second (fmap dodrag) $
hiteff bt hitstream w
where
endspawn w' = fromMaybe w' $ do
partspawn <- bulletSpawn bt'
return $ partspawn p w'
hitstream = thingsHit p (p +.+ vel) w
bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w))
& buState .~ NormalBulletState
dodrag = case _buTrajectory bt of
BasicBulletTrajectory -> buVel .*.*~ drag
MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt)
FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
BezierTrajectory spos tpos xpos ->
let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05
in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt)
drag = _buDrag bt
p = _buPos bt
vel = _buVel bt
hiteff = hitEffFromBul x
t = _buTimer bt
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_,Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
bounceDir (p,Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
bounceDir _ = Nothing
bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
@@ -87,66 +91,84 @@ bulletSpawn bu = case _buSpawn bu of
BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
BulBall TeslaBall -> Just makeStaticBall
hitEffFromBul :: Float -> Bullet
-> [(Point2, Either Creature Wall)]
-> World
-> (World,Maybe Bullet)
hitEffFromBul x bu hitstream w = case _buEffect bu of
hitEffFromBul ::
Float ->
World ->
Bullet ->
(World, Maybe Bullet)
hitEffFromBul x w bu = case _buEffect bu of
PenetrateBullet -> movePenBullet x bu hitstream w
BounceBullet -> case List.safeHead hitstream of
BounceBullet -> case List.safeHead hitstream of
Nothing -> (w, moveBullet x bu)
Just (hp,crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
dir <- bounceDir (hp,crwl)
return (w,Just $ bu
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
& buVel %~ reflectIn dir
& buTrajectory .~ BasicBulletTrajectory
& buTimer -~ 1
Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
dir <- bounceDir (hp, crwl)
return
( w
, Just $
bu
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
& buVel %~ reflectIn dir
& buTrajectory .~ BasicBulletTrajectory
& buTimer -~ 1
)
DestroyBullet -> expireAndDamage x bu hitstream w
where
ep = sp +.+ x *.* _buVel bu
sp = _buPos bu
hitstream = thingsHit sp ep w
setFromToDams :: Bullet -> Point2 -> [Damage]
setFromToDams bu p = map f (_buDamages bu)
where
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
damageThingHit :: Bullet -> (Point2,Either Creature Wall) -> World -> World
damageThingHit bu (p,crwl) = case crwl of
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
damageThingHit bu (p, crwl) = case crwl of
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
where
dams = setFromToDams bu p
expireAndDamage :: Float
-> Bullet
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Bullet)
expireAndDamage ::
Float ->
Bullet ->
[(Point2, Either Creature Wall)] ->
World ->
(World, Maybe Bullet)
expireAndDamage y bt things w = case List.safeHead things of
Nothing -> (w, moveBullet y bt)
Just x -> (damageThingHit bt x w, destroyAt (fst x) bt)
moveBullet :: Float -> Bullet -> Maybe Bullet
moveBullet x pt = Just $ pt
& buPos %~ (+.+ x *.* _buVel pt)
& buOldPos .~ _buPos pt
& buTimer -~ 1
moveBullet x pt =
Just $
pt
& buPos %~ (+.+ x *.* _buVel pt)
& buOldPos .~ _buPos pt
& buTimer -~ 1
destroyAt :: Point2 -> Bullet -> Maybe Bullet
destroyAt hitp pt = Just $ pt
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
& buOldPos .~ p
& buVel .~ 0
destroyAt hitp pt =
Just $
pt
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
& buOldPos .~ p
& buVel .~ 0
where
p = _buPos pt
movePenBullet :: Float -> Bullet -> [(Point2, Either Creature Wall)]
-> World -> (World, Maybe Bullet)
movePenBullet ::
Float ->
Bullet ->
[(Point2, Either Creature Wall)] ->
World ->
(World, Maybe Bullet)
movePenBullet x bu hitstream w = case hitstream of
[] -> (w,moveBullet x bu)
((p,crwl):strm) -> if penThing crwl
then first (damageThingHit bu (p,crwl)) $ movePenBullet x bu strm w
else expireAndDamage x bu hitstream w
[] -> (w, moveBullet x bu)
((p, crwl) : strm) ->
if penThing crwl
then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w
else expireAndDamage x bu hitstream w
penThing :: Either Creature Wall -> Bool
penThing (Left _) = True
src/Dodge/Combine.hs
+6 -6
View File
@@ -29,23 +29,23 @@ import qualified Data.Map.Strict as M
import Data.Maybe
import Data.List (scanl',sortOn)
invertInventory :: IM.IntMap Item -> [(ItemBaseType,IcAmount,Int)]
invertInventory :: IM.IntMap Item -> [(ItemBaseType,ItAmount,Int)]
invertInventory = IM.foldrWithKey
(\k it -> ((_iyBase $ _itType it, itStackAmount it,k) :) )
[]
splitIcAmounts :: [(ItemBaseType,IcAmount,Int)] -> [((IcAmount,ItemBaseType),(IcAmount,Int))]
splitIcAmounts = concatMap f
splitItAmounts :: [(ItemBaseType,ItAmount,Int)] -> [((ItAmount,ItemBaseType),(ItAmount,Int))]
splitItAmounts = concatMap f
where
f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
lookupItems :: IM.IntMap Item -> [([(ItAmount,Int)],Item)]
lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitItAmounts . invertInventory
combineItemListYouX :: World -> [([Int],Item)]
combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
where
g (amount,i) = replicate (_toInt amount) i
g (amount,i) = replicate (_getItAmount amount) i
combineListInfo :: World -> [([Int],([String],Item))]
combineListInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w
src/Dodge/Combine/Combinations.hs
+1 -1
View File
@@ -14,7 +14,7 @@ import LensHelp
--import Data.Maybe
itemCombinations :: [([(IcAmount,ItemBaseType)],Item)]
itemCombinations :: [([(ItAmount,ItemBaseType)],Item)]
itemCombinations =
[ po [CRAFT PIPE, CRAFT HARDWARE] (bangStick 1)
, po [HELD (BANGSTICK 1), CRAFT TIN] pistol
src/Dodge/Combine/Graph.hs
+3 -3
View File
@@ -19,7 +19,7 @@ data CombClust
| JoinClust
deriving (Eq,Ord,Show,Enum,Bounded)
newtype CombNode = CombNode {_unCombNode :: Either ItemBaseType [(IcAmount,ItemBaseType)]}
newtype CombNode = CombNode {_unCombNode :: Either ItemBaseType [(ItAmount,ItemBaseType)]}
deriving (Eq,Ord,Show)
instance Labellable CombNode where
@@ -32,7 +32,7 @@ instance Labellable CombEdge where
toLabelValue (CombEdge 0) = StrLabel (pack "")
toLabelValue (CombEdge x) = StrLabel (pack $ show x)
bulletCombinations :: [([(IcAmount,ItemBaseType)],Item)]
bulletCombinations :: [([(ItAmount,ItemBaseType)],Item)]
bulletCombinations = filter
( (`elem` map totype bulletWeapons)
. totype
@@ -63,7 +63,7 @@ itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) itemCombinat
| otherwise = (CombNode $ Right abts,CombNode $ Left bt,0) : map g abts
where
bts = map snd abts
g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_toInt am)
g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_getItAmount am)
combinationsGraph :: FGL.Gr CombNode CombEdge
combinationsGraph = FGL.labnfilter (f . _unCombNode . snd)
src/Dodge/Combine/Module.hs
+13 -13
View File
@@ -8,28 +8,28 @@ import Geometry
moduleModification :: ItemModuleType -> Item -> Item
moduleModification imt = case imt of
EMPTYMODULE -> id
DRUMMAG -> itConsumption . laMax .~ 45
BELTMAG -> itConsumption . laMax .~ 150
DRUMMAG -> itUse . heldConsumption . laMax .~ 45
BELTMAG -> itUse . heldConsumption . laMax .~ 150
MAGNETMAG -> itUse . useDelay . rateMax .~ 4
INCENDBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
BOUNCEBUL -> itConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet
PENBUL -> itConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet
STATICBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
CONCUSBUL -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
INCENDBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
BOUNCEBUL -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet
PENBUL -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet
STATICBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
CONCUSBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
TARGCR -> itTargeting .~ targetRBCreature
TARGLAS -> itTargeting .~ targetLaser
TARGPOS -> itTargeting .~ targetRBPress
MAGNETTRAJ -> (itConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0)
. (itConsumption . laAmmoType . amBullet . buVel .~ V2 10 0)
FLECHETRAJ -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0
BEZIERTRAJ -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
MAGNETTRAJ -> (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0)
. (itUse . heldConsumption . laAmmoType . amBullet . buVel .~ V2 10 0)
FLECHETRAJ -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0
BEZIERTRAJ -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
INCENDLAS -> itParams . lasBeam .~ BeamCombine FlameBeamCombine
SPLITLAS -> itParams . lasBeam .~ BeamCombine SplitBeamCombine
STATICLAS -> (itParams . lasBeam .~ BeamCombine TeslaBeamCombine)
. (itParams . subParams ?~ teslaParams)
WEPTELE -> makeDirectedTele
LAUNCHHOME -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
EXTRABATTERY -> itConsumption . laMax +~ 1000
LAUNCHHOME -> itUse . heldConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
EXTRABATTERY -> itUse . heldConsumption . laMax +~ 1000
ATTACHTORCH -> id
where
makeDirectedTele it = it
src/Dodge/Combine/Trie.hs
+1 -1
View File
@@ -11,7 +11,7 @@ import Data.Bifunctor
--import Data.Map.Merge.Strict
import Data.List (sort)
combinationsTrie :: Trie (IcAmount,ItemBaseType) Item
combinationsTrie :: Trie (ItAmount,ItemBaseType) Item
{-# INLINE combinationsTrie #-}
combinationsTrie = foldr
(uncurry insertInTrie . first sort)
src/Dodge/Config/Data.hs
-112
View File
@@ -1,112 +0,0 @@
--{-# LANGUAGE FlexibleInstances #-}
--{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Dodge.Config.Data where
import Data.Aeson
import qualified Data.Set as S
import GHC.Generics
import Control.Lens
--import Data.Enum.Set.Base
{-# ANN module "HLint: ignore Use camelCase" #-}
data Configuration = Configuration
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
, _graphics_wall_textured :: Bool
, _graphics_cloud_shadows :: Bool
, _graphics_object_shadows :: Bool
, _graphics_resolution_factor :: ResFactor
, _windowX :: Float
, _windowY :: Float
, _windowPosX :: Int
, _windowPosY :: Int
, _gameplay_rotate_to_wall :: Bool
, _debug_view_clip_bounds :: RoomClipping
, _debug_booleans :: S.Set DebugBool -- consider using Data.BitSet
}
deriving (Generic, Show)
data DebugBool
= Show_ms_frame
| Show_debug
| Show_sound
| Noclip
| Cr_status
| Cr_awareness
| Mouse_position
| View_boundaries
| Walls_info
| Pathing
| Remove_LOS
| Cull_more_lights
| Close_shape_culling
| Show_bound_box
| Bound_box_screen
| Show_wall_search_rays
| Show_dda_test
| Show_far_wall_detect
| Show_select
| Inspect_wall
| Show_nodes_near_select
| Show_path_between
deriving (Generic, Eq,Ord,Bounded, Enum, Show)
data ResFactor = FullRes | HalfRes | QuarterRes
deriving (Generic, Show, Eq, Ord, Enum, Bounded)
instance ToJSON ResFactor where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ResFactor
data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
deriving (Generic, Show, Eq, Ord, Enum, Bounded)
instance ToJSON RoomClipping where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RoomClipping
resFactorNum :: ResFactor -> Int
resFactorNum rf = case rf of
FullRes -> 1
HalfRes -> 2
QuarterRes -> 4
makeLenses ''Configuration
instance ToJSON DebugBool where
toEncoding = genericToEncoding defaultOptions
instance ToJSON Configuration where
toEncoding = genericToEncoding defaultOptions
--deriving instance Generic a => Generic (EnumSet Word a)
--instance FromJSON (EnumSet Word a)
instance FromJSON DebugBool
instance FromJSON Configuration
defaultConfig :: Configuration
defaultConfig = Configuration
{ _volume_master = 1
, _volume_sound = 1
, _volume_music = 1
, _graphics_wall_textured = True
, _graphics_cloud_shadows = True
, _graphics_object_shadows = True
, _graphics_resolution_factor = FullRes
, _windowX = 800
, _windowY = 600
, _windowPosX = 0
, _windowPosY = 0
, _gameplay_rotate_to_wall = True
, _debug_booleans = S.singleton Show_ms_frame
, _debug_view_clip_bounds = NoRoomClipBoundaries
-- , _debug_show_sound = False
-- , _debug_seconds_frame = True
-- , _debug_noclip = False
-- , _debug_mouse_position = False
-- , _debug_cr_status = False
-- , _debug_cr_awareness = False
-- , _debug_view_boundaries = False
-- , _debug_pathing = False
-- , _debug_walls = False
-- , _debug_remove_LOS = False
-- , _debug_cull_more_lights = False
}
debugOn :: DebugBool -> Configuration -> Bool
debugOn db = S.member db . _debug_booleans
src/Dodge/Config/Load.hs
+13 -13
View File
@@ -1,22 +1,22 @@
module Dodge.Config.Load
( loadDodgeConfig
) where
import Dodge.Config.Data
module Dodge.Config.Load (
loadDodgeConfig,
) where
import Data.Aeson
import Dodge.Data.Config
import System.Directory
loadDodgeConfig :: IO Configuration
loadDodgeConfig = do
fExists <- doesFileExist "data/dodge.config.json"
if fExists
then do
mayConfig <- decodeFileStrict "data/dodge.config.json"
case mayConfig of
Just config -> return config
Nothing -> do
putStrLn "invalid data/dodge.config.json, loading defaults"
then do
mayConfig <- decodeFileStrict "data/dodge.config.json"
case mayConfig of
Just config -> return config
Nothing -> do
putStrLn "invalid data/dodge.config.json, loading defaults"
return defaultConfig
else do
putStrLn "No data/data/dodge.config.json found, loading defaults"
return defaultConfig
else do
putStrLn "No data/data/dodge.config.json found, loading defaults"
return defaultConfig
src/Dodge/Config/Update.hs
+28 -26
View File
@@ -1,51 +1,53 @@
{-|
{- |
IO actions that apply config side effects and save configuration settings to disk.
-}
module Dodge.Config.Update
( saveConfig
, setVolThen
, applyWorldConfig
, setVol
) where
--import Dodge.Data.SoundOrigin
import Dodge.Config.Data
import Sound
import Data.Preload
import Preload.Update
module Dodge.Config.Update (
saveConfig,
setVolThen,
applyWorldConfig,
setVol,
) where
import qualified Data.Aeson.Encode.Pretty as AEP
import qualified Data.ByteString.Lazy as BS
--import Control.Monad (when)
import Data.Preload
import Dodge.Data.Config
import Preload.Update
import Sound
{- |
Write the current world configuration to disk as a json file.
-}
-}
saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
saveConfig cfig f x = do
putStrLn "Saving config to data/dodge.config.json"
BS.writeFile "data/dodge.config.json"
$ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
BS.writeFile "data/dodge.config.json" $
AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
f x
{- |
Apply the volume settings from the world configuration to the running game.
-}
-}
setVol :: Configuration -> IO ()
setVol cfig = do
setSoundVolume ( _volume_master cfig * _volume_sound cfig)
setMusicVolume ( _volume_master cfig * _volume_music cfig)
setSoundVolume (_volume_master cfig * _volume_sound cfig)
setMusicVolume (_volume_master cfig * _volume_music cfig)
-- what?
setVolThen :: Configuration -> (a -> IO a) -> a -> IO a
setVolThen cfig f a = do
setVol cfig
setVol cfig
f a
{- |
Apply /all/ of the values in the world configuration to the running game.
-}
applyWorldConfig
:: Configuration
-> PreloadData
-> IO PreloadData
-}
applyWorldConfig ::
Configuration ->
PreloadData ->
IO PreloadData
applyWorldConfig cfig pdata = do
setVol cfig
setVol cfig
pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y pdata
where
x = round $ _windowX cfig
src/Dodge/Creature/Impulse/UseItem.hs
+63 -57
View File
@@ -1,97 +1,101 @@
module Dodge.Creature.Impulse.UseItem
( useItem
, useLeftItem
, itemEffect
) where
import Dodge.Data
import Dodge.Luse
import Dodge.Cuse
import Dodge.Euse
import Dodge.Inventory
import Dodge.Reloading
import Dodge.Item.Location
import Dodge.HeldUse
module Dodge.Creature.Impulse.UseItem (
useItem,
useLeftItem,
itemEffect,
) where
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
import qualified SDL
--import qualified Data.IntSet as IS
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Cuse
import Dodge.Data
import Dodge.Euse
import Dodge.HeldUse
import Dodge.Inventory
import Dodge.Item.Location
import Dodge.Luse
import Dodge.Reloading
import qualified IntMapHelp as IM
import qualified SDL
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? cWorld . creatures . ix (_crID cr')
cr <- w ^? cWorld . creatures . ix (_crID cr')
it <- cr ^? crInv . ix (crSel cr)
return $ itemEffect cr it w
where
f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^? itUse of
Just RightUse {_rUse = eff,_useMods = usemods}
-> hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
Just LeftUse {} -> doequipmentchange
Just EquipUse{} -> doequipmentchange
itemEffect cr it w = case it ^. itUse of
RightUse{_rUse = eff, _useMods = usemods} ->
hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
Just NoUse -> setuhamdown w
Nothing -> setuhamdown w
(ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
CraftUse{} -> setuhamdown w
where
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
doequipmentchange =
setuhamdown $
hammerTest
( toggleEquipmentAt (_rbOptions w) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr
)
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
tryReload cr it w f
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False
= crToggleReloading cr
| otherwise
= (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
. f
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
crToggleReloading cr
| otherwise =
(runIdentity . pointerToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
. f
itNeedsLoading :: Item -> Bool
itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
where
ic = _itConsumption it
ic = _heldConsumption (_itUse it)
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
activateEquipmentAt rbo cr =
cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i, _) -> crLeftInvSel ?~ i
(_, Just _) -> crLeftInvSel .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp}
-> w
Just PutOnEquipment{_allocNewPos = newp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> w
Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> w
Just SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> w
Just ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
Just RemoveEquipment {_allocOldPos = oldp }
-> w
Just RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
@@ -104,21 +108,23 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
onremove itm' = useE ((_eqOnRemove . _eqEq . _itUse) itm') itm'
useLeftItem :: Int -> World -> World
useLeftItem cid w
useLeftItem cid w
| _crInvLock cr = w
| itmShouldBeUsed = useItem cr w -- I believe this ONLY sets equipment options
| otherwise = fromMaybe w $ do
invid <- _crLeftInvSel cr
itm <- cr ^? crInv . ix invid
f <- cr ^? crInv . ix invid . itUse . lUse
return
. (runIdentity . pointToItem (_itPos itm) (return . (itUse . useHammer .~ HammerDown)))
. useL f itm cr
f <- cr ^? crInv . ix invid . itUse . lUse
return
. (runIdentity . pointerToItem (_itPos itm) (return . (itUse . useHammer .~ HammerDown)))
. useL f itm cr
$ w
where
cr = _creatures (_cWorld w) IM.! cid
itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr)
)
-- TODO determine itmShouldBeUsed with reference to config options
itmShouldBeUsed =
isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr)
)
-- TODO determine itmShouldBeUsed with reference to config options
src/Dodge/Creature/ReaderUpdate.hs
+1 -1
View File
@@ -135,7 +135,7 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
reloadOverride :: Creature -> Creature
reloadOverride cr
| cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded == Just 0
| cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
&& cr ^. crStance . posture == Aiming
= cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
| otherwise = cr
src/Dodge/Creature/State.hs
+4 -4
View File
@@ -216,10 +216,10 @@ itemUpdate cr i
. (itPos .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case _itConsumption it of
AutoRecharging l m t p
| l < m && p <= 0 -> it & itConsumption .~ AutoRecharging (l+1) m t t
| l < m -> it & itConsumption . arProgress -~ 1
updateAutoRecharge it = case it ^? itUse . leftConsumption of
Just (AutoRecharging l m t p)
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l+1) m t t
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
_ -> it
doItemTargeting :: Int -> Creature -> World -> World
doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
src/Dodge/Creature/Statistics.hs
+19 -15
View File
@@ -1,16 +1,16 @@
module Dodge.Creature.Statistics
( getCrStrength
, getCrDexterity
) where
import Dodge.Data
module Dodge.Creature.Statistics (
getCrStrength,
getCrDexterity,
) where
--import Data.Strict.IntMap.Autogen.Merge.Strict
import Data.IntMap.Merge.Strict
import Data.Maybe
import Dodge.Creature.Test
import Dodge.Data
import qualified IntMapHelp as IM
import LensHelp
import Data.Maybe
import Data.Strict.IntMap.Autogen.Merge.Strict
--import Data.IntMap.Merge.Strict
getCrDexterity :: Creature -> Int
getCrDexterity cr = _dexterity (_crStatistics cr)
@@ -23,16 +23,20 @@ strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
equipmentStrValue :: Item -> Int
equipmentStrValue itm = case _iyBase $ _itType itm of
EQUIP FRONTARMOUR -> negate 3
EQUIP POWERLEGS -> 3
EQUIP POWERLEGS -> 3
_ -> 0
crCurrentEquipment :: Creature -> IM.IntMap Item
crCurrentEquipment cr = merge dropMissing dropMissing (zipWithMatched (\_ _ itm -> itm))
(_crInvEquipped cr)
(_crInv cr)
crCurrentEquipment cr =
merge
dropMissing
dropMissing
(zipWithMatched (\_ _ itm -> itm))
(_crInvEquipped cr)
(_crInv cr)
strFromHeldItem :: Creature -> Int
strFromHeldItem cr
| _posture (_crStance cr) == Aiming || crIsReloading cr
= negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
| _posture (_crStance cr) == Aiming || crIsReloading cr =
negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
| otherwise = 0
src/Dodge/Creature/Test.hs
+1 -1
View File
@@ -41,7 +41,7 @@ crIsReloading cr = case cr ^? crInvSel . iselAction of
crWeaponReady :: Creature -> Bool
crWeaponReady cr = fromMaybe False $ do
ic <- cr ^? crInv . ix (crSel cr) . itConsumption
ic <- cr ^? crInv . ix (crSel cr) . itUse . heldConsumption
return (_laLoaded ic > 0 && _laPrimed ic)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
src/Dodge/Data.hs
+6 -14
View File
@@ -22,8 +22,6 @@ module Dodge.Data (
module Dodge.Data.WorldEffect,
module Dodge.Data.Button,
module Dodge.Data.Beam,
module Dodge.Data.Targeting,
module Dodge.Data.ItEffect,
module Dodge.Data.Hammer,
module Dodge.Data.ArcStep,
module Dodge.Data.CrWlID,
@@ -54,14 +52,12 @@ module Dodge.Data (
module Dodge.Data.Zoning,
module Dodge.Data.Bounds,
module Dodge.Data.Sensor,
module Dodge.Combine.Data,
module Dodge.Distortion.Data,
module Dodge.Data.Distortion,
module Dodge.Data.Damage,
module Dodge.Data.SoundOrigin,
module Dodge.Config.Data,
module Dodge.Data.Config,
module MaybeHelp,
module Dodge.Data.ItemAmount,
module Dodge.RoomCluster.Data,
module Dodge.Data.RoomCluster,
module Dodge.Data.Room,
module Dodge.Data.RadarBlip,
module Dodge.Data.PathGraph,
@@ -93,8 +89,7 @@ import Data.Preload
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tile
import Dodge.Combine.Data
import Dodge.Config.Data
import Dodge.Data.Config
import Dodge.Config.KeyConfig
import Dodge.Data.ActionPlan
import Dodge.Data.Ammo
@@ -122,9 +117,7 @@ import Dodge.Data.GenParams
import Dodge.Data.Gust
import Dodge.Data.HUD
import Dodge.Data.Hammer
import Dodge.Data.ItEffect
import Dodge.Data.Item
import Dodge.Data.ItemAmount
import Dodge.Data.Laser
import Dodge.Data.LightSource
import Dodge.Data.LinearShockwave
@@ -149,15 +142,14 @@ import Dodge.Data.Sensor
import Dodge.Data.Shockwave
import Dodge.Data.SoundOrigin
import Dodge.Data.Spark
import Dodge.Data.Targeting
import Dodge.Data.Terminal
import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Dodge.Data.Zoning
import Dodge.Distortion.Data
import Dodge.RoomCluster.Data
import Dodge.Data.Distortion
import Dodge.Data.RoomCluster
import GHC.Generics
import Geometry.Data
import qualified IntMapHelp as IM
src/Dodge/Data/ActionPlan.hs
+13 -39
View File
@@ -1,15 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.ActionPlan where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Creature.Stance
import Dodge.Data.CreatureEffect
import GHC.Generics
import Geometry.Data
import Sound.Data
@@ -21,22 +19,12 @@ data ActionPlan
, _apStrategy :: Strategy
, _apGoal :: [Goal]
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ActionPlan where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ActionPlan
deriving (Eq, Ord, Show, Read)
data RandImpulse
= RandImpulseList [Impulse]
| RandImpulseCircMove Float
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON RandImpulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RandImpulse
deriving (Eq, Ord, Show, Read)
data Impulse
= Move Point2
@@ -70,12 +58,7 @@ data Impulse
{ _impulseUseAheadPos :: P2Imp
}
| ImpulseNothing
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Impulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Impulse
deriving (Eq, Ord, Show, Read)
infixr 9 `WaitThen`
@@ -182,12 +165,7 @@ data Action
{ _sideImpulses :: [Impulse]
, _mainAction :: Action
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Action where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Action
deriving (Eq, Ord, Show, Read)
data Strategy
= Flank Int
@@ -205,24 +183,20 @@ data Strategy
| Reload
| Flee
| MeleeStrike
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Strategy where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Strategy
deriving (Eq, Ord, Show, Read)
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Goal where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Goal
deriving (Eq, Ord, Show, Read)
deriveJSON defaultOptions ''ActionPlan
deriveJSON defaultOptions ''RandImpulse
deriveJSON defaultOptions ''Impulse
deriveJSON defaultOptions ''Action
deriveJSON defaultOptions ''Strategy
deriveJSON defaultOptions ''Goal
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
src/Dodge/Data/Ammo.hs
+25 -27
View File
@@ -1,36 +1,32 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Ammo where
import GHC.Generics
import Control.Lens
import Data.Aeson
import Dodge.Data.Payload
import Data.Aeson.TH
import Dodge.Data.Bullet
import Dodge.Data.Gas
import Dodge.Data.Payload
import Dodge.Data.Wall
import Control.Lens
data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
instance ToJSON ProjectileDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProjectileDraw
deriving (Show, Read, Eq, Ord, Enum, Bounded)
data ProjectileCreate = CreateShell | CreateTrackingShell
deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
instance ToJSON ProjectileCreate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProjectileCreate
data ProjectileUpdate
deriving (Show, Read, Eq, Ord, Enum, Bounded)
data ProjectileUpdate
= PJThrust {_pjuStart :: Int, _pjuEnd :: Int}
| PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| PJTrack {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int}
| PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| PJTrack {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int}
| PJReduceSpin {_pjuReduceSpin :: Float}
| PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int}
| PJSetScope {_pjuITID :: Int}
| PJRetireRemote {_pjuITID :: Int, _pjuTimer :: Int, _pjuPJID :: Int}
deriving (Show,Read,Eq,Ord,Generic)
instance ToJSON ProjectileUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProjectileUpdate
deriving (Show, Read, Eq, Ord)
data AmmoType
= ProjectileAmmo
{ _amPayload :: Payload
@@ -39,22 +35,24 @@ data AmmoType
, _amPjCreation :: ProjectileCreate
}
| BulletAmmo
{ _amString :: String
{ _amString :: String
, _amBullet :: Bullet
}
| DroneAmmo
{ _amString :: String }
{_amString :: String}
| GasAmmo
{ _amString :: String
{ _amString :: String
, _amCreateGas :: GasCreate
}
| ForceFieldAmmo
{ _amForceFieldType :: Wall
}
| GenericAmmo
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON AmmoType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AmmoType
deriving (Eq, Ord, Show, Read)
makeLenses ''ProjectileUpdate
makeLenses ''AmmoType
deriveJSON defaultOptions ''ProjectileDraw
deriveJSON defaultOptions ''ProjectileCreate
deriveJSON defaultOptions ''ProjectileUpdate
deriveJSON defaultOptions ''AmmoType
src/Dodge/Data/Bullet.hs
+36 -45
View File
@@ -1,66 +1,57 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Bullet where
import GHC.Generics
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Damage
import Geometry.Data
import Control.Lens
data Bullet = Bullet
{ _buState :: BulletState
, _buEffect :: BulletEffect
, _buSpawn :: BulletSpawn
, _buUpdateMod :: BulletUpdateMod
{ _buDelayFraction :: Float
, _buEffect :: BulletEffect
, _buSpawn :: BulletSpawn
, _buUpdateMod :: BulletUpdateMod
, _buTrajectory :: BulletTrajectory
, _buVel :: Point2
, _buDrag :: Float
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buTimer :: Int
, _buDamages :: [Damage]
, _buVel :: Point2
, _buDrag :: Float
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buTimer :: Int
, _buDamages :: [Damage]
}
deriving (Show,Read,Eq,Ord,Generic)
instance ToJSON Bullet where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Bullet
deriving (Show, Read, Eq, Ord)
data EnergyBallType = IncBall | TeslaBall | ConcBall
deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
instance ToJSON EnergyBallType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EnergyBallType
data BulletState = NormalBulletState
| DelayedBullet Float
deriving (Show,Read,Eq,Ord,Generic)
instance ToJSON BulletState where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BulletState
deriving (Show, Read, Eq, Ord, Enum, Bounded)
data BulletUpdateMod = NoBulletUpdateMod
deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
instance ToJSON BulletUpdateMod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BulletUpdateMod
data BulletEffect
deriving (Show, Read, Eq, Ord, Enum, Bounded)
data BulletEffect
= DestroyBullet
| BounceBullet
| PenetrateBullet
deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic)
instance ToJSON BulletEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BulletEffect
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data BulletSpawn = BulBall EnergyBallType | BulSpark
deriving (Show,Read,Eq,Ord,Generic)
instance ToJSON BulletSpawn where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BulletSpawn
deriving (Show, Read, Eq, Ord)
data BulletTrajectory
= BasicBulletTrajectory
| BezierTrajectory Point2 Point2 Point2
| FlechetteTrajectory Point2
| MagnetTrajectory Point2
deriving (Show,Read,Eq,Ord,Generic)
instance ToJSON BulletTrajectory where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BulletTrajectory
deriving (Show, Read, Eq, Ord)
makeLenses ''Bullet
deriveJSON defaultOptions ''Bullet
deriveJSON defaultOptions ''EnergyBallType
deriveJSON defaultOptions ''BulletUpdateMod
deriveJSON defaultOptions ''BulletEffect
deriveJSON defaultOptions ''BulletSpawn
deriveJSON defaultOptions ''BulletTrajectory
src/Dodge/Data/Button.hs
+2 -2
View File
@@ -38,7 +38,7 @@ data ButtonEvent = ButtonDoNothing
,_boffEff :: WdWd
}
| ButtonAccessTerminal
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq,Show,Read,Generic)
instance ToJSON ButtonEvent where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ButtonEvent
@@ -54,7 +54,7 @@ data Button = Button
, _btName :: String
, _btColor :: Color
}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq,Show,Read,Generic)
instance ToJSON Button where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Button
src/Dodge/Data/CWorld.hs
+8 -16
View File
@@ -1,11 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CWorld where
module Dodge.Data.CWorld (
module Dodge.Data.CWorld,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Data.Graph.Inductive
import qualified Data.IntSet as IS
import Dodge.Data.Beam
@@ -18,6 +20,7 @@ import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.Creature
import Dodge.Data.Damage
import Dodge.Data.Distortion
import Dodge.Data.Door
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
@@ -48,9 +51,7 @@ import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Dodge.Distortion.Data
import Dodge.GameRoom
import GHC.Generics
import Geometry.ConvexPoly
import Geometry.Data
import qualified IntMapHelp as IM
@@ -135,12 +136,6 @@ data CWorld = CWorld
, _genParams :: GenParams
, _deathDelay :: Maybe Int
}
deriving (Eq, Show, Read, Generic)
instance ToJSON CWorld where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CWorld
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
@@ -148,12 +143,9 @@ data WorldBeams = WorldBeams
, _positronBeams :: [Beam]
, _electronBeams :: [Beam]
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON WorldBeams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WorldBeams
deriving (Eq, Ord, Show, Read)
deriveJSON defaultOptions ''CWorld
deriveJSON defaultOptions ''WorldBeams
makeLenses ''CWorld
makeLenses ''WorldBeams
src/Dodge/Data/Config.hs
+122
View File
@@ -0,0 +1,122 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Config where
import Control.Lens
import Data.Aeson
import qualified Data.Set as S
import GHC.Generics
{-# ANN module "HLint: ignore Use camelCase" #-}
data Configuration = Configuration
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
, _graphics_wall_textured :: Bool
, _graphics_cloud_shadows :: Bool
, _graphics_object_shadows :: Bool
, _graphics_resolution_factor :: ResFactor
, _windowX :: Float
, _windowY :: Float
, _windowPosX :: Int
, _windowPosY :: Int
, _gameplay_rotate_to_wall :: Bool
, _debug_view_clip_bounds :: RoomClipping
, _debug_booleans :: S.Set DebugBool -- consider using Data.BitSet
}
deriving (Generic, Show)
data DebugBool
= Show_ms_frame
| Show_debug
| Show_sound
| Noclip
| Cr_status
| Cr_awareness
| Mouse_position
| View_boundaries
| Walls_info
| Pathing
| Remove_LOS
| Cull_more_lights
| Close_shape_culling
| Show_bound_box
| Bound_box_screen
| Show_wall_search_rays
| Show_dda_test
| Show_far_wall_detect
| Show_select
| Inspect_wall
| Show_nodes_near_select
| Show_path_between
deriving (Generic, Eq, Ord, Bounded, Enum, Show)
data ResFactor = FullRes | HalfRes | QuarterRes
deriving (Generic, Show, Eq, Ord, Enum, Bounded)
instance ToJSON ResFactor where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ResFactor
data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
deriving (Generic, Show, Eq, Ord, Enum, Bounded)
instance ToJSON RoomClipping where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RoomClipping
resFactorNum :: ResFactor -> Int
resFactorNum rf = case rf of
FullRes -> 1
HalfRes -> 2
QuarterRes -> 4
makeLenses ''Configuration
instance ToJSON DebugBool where
toEncoding = genericToEncoding defaultOptions
instance FromJSON DebugBool
instance ToJSON Configuration where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Configuration
defaultConfig :: Configuration
defaultConfig =
Configuration
{ _volume_master = 1
, _volume_sound = 1
, _volume_music = 1
, _graphics_wall_textured = True
, _graphics_cloud_shadows = True
, _graphics_object_shadows = True
, _graphics_resolution_factor = FullRes
, _windowX = 800
, _windowY = 600
, _windowPosX = 0
, _windowPosY = 0
, _gameplay_rotate_to_wall = True
, _debug_booleans = S.singleton Show_ms_frame
, _debug_view_clip_bounds = NoRoomClipBoundaries
-- , _debug_show_sound = False
-- , _debug_seconds_frame = True
-- , _debug_noclip = False
-- , _debug_mouse_position = False
-- , _debug_cr_status = False
-- , _debug_cr_awareness = False
-- , _debug_view_boundaries = False
-- , _debug_pathing = False
-- , _debug_walls = False
-- , _debug_remove_LOS = False
-- , _debug_cull_more_lights = False
}
debugOn :: DebugBool -> Configuration -> Bool
debugOn db = S.member db . _debug_booleans
src/Dodge/Data/Creature.hs
+77 -66
View File
@@ -1,88 +1,99 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Creature
( module Dodge.Data.Creature
, module Dodge.Data.Creature.Misc
, module Dodge.Data.Creature.State
, module Dodge.Data.Creature.Perception
, module Dodge.Data.Creature.Memory
, module Dodge.Data.Creature.Stance
) where
import GHC.Generics
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Creature (
module Dodge.Data.Creature,
module Dodge.Data.Creature.Misc,
module Dodge.Data.Creature.State,
module Dodge.Data.Creature.Perception,
module Dodge.Data.Creature.Memory,
module Dodge.Data.Creature.Stance,
) where
import Control.Lens
import Data.Aeson
import qualified Data.Map.Strict as M
import Dodge.Data.ActionPlan
import Dodge.Data.Creature.Memory
import Dodge.Data.Creature.Misc
import Dodge.Data.Creature.Perception
import Dodge.Data.Creature.Stance
import Dodge.Data.Creature.State
import Dodge.Data.Hammer
import Dodge.Data.Item
import Dodge.Data.LoadAction
import Dodge.Data.Material
import Dodge.Data.ActionPlan
import Dodge.Data.Hammer
import Dodge.Data.Creature.Perception
import Dodge.Data.Creature.Memory
import Dodge.Data.Creature.Stance
import GHC.Generics
import Geometry.Data
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
import Control.Lens
data Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
, _crVel :: Point2
, _crDir :: Float
, _crOldDir :: Float
, _crMvDir :: Float
, _crTwist :: Float
, _crType :: CreatureType
, _crID :: Int
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: InvSel
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
, _crEquipment :: M.Map EquipPosition Int
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
, _crMaterial :: Material
, _crPastDamage :: Int
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: Int
, _crPerception :: Perception
, _crMemory :: Memory
, _crVocalization :: Vocalization
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crIntention :: Intention
, _crMvType :: CrMvType
{ _crPos :: Point2
, _crOldPos :: Point2
, _crVel :: Point2
, _crDir :: Float
, _crOldDir :: Float
, _crMvDir :: Float
, _crTwist :: Float
, _crType :: CreatureType
, _crID :: Int
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: InvSel
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
, _crEquipment :: M.Map EquipPosition Int
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
, _crMaterial :: Material
, _crPastDamage :: Int
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: Int
, _crPerception :: Perception
, _crMemory :: Memory
, _crVocalization :: Vocalization
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crIntention :: Intention
, _crMvType :: CrMvType
, _crHammerPosition :: HammerPosition
, _crName :: String
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
, _crName :: String
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Creature where
deriving (Eq, Show, Read, Generic)
instance ToJSON Creature where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Creature
instance FromJSON Creature
data CreatureCorpse = MakeDefaultCorpse
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CreatureCorpse where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON CreatureCorpse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CreatureCorpse
instance FromJSON CreatureCorpse
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Intention where
deriving (Eq, Show, Read, Generic)
instance ToJSON Intention where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Intention
instance FromJSON Intention
makeLenses ''Creature
makeLenses ''Intention
src/Dodge/Data/Distortion.hs
+13
View File
@@ -0,0 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Distortion where
import Data.Aeson
import Data.Aeson.TH
import Geometry
data Distortion
= RadialDistortion Point2 Point2 Point2 Float
deriving (Eq,Ord,Show,Read)
deriveJSON defaultOptions ''Distortion
src/Dodge/Data/FloorItem.hs
+1 -1
View File
@@ -9,7 +9,7 @@ import GHC.Generics
import Data.Aeson
import Control.Lens
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq,Show,Read,Generic)
instance ToJSON FloorItem where
toEncoding = genericToEncoding defaultOptions
instance FromJSON FloorItem
src/Dodge/Data/HUD.hs
+33 -21
View File
@@ -1,39 +1,51 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.HUD where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
data HUDElement
import Data.Aeson
import GHC.Generics
import Geometry.Data
data HUDElement
= DisplayInventory {_subInventory :: SubInventory}
| DisplayCarte
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON HUDElement where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON HUDElement where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HUDElement
data SubInventory
instance FromJSON HUDElement
data SubInventory
= NoSubInventory
| TweakInventory
| TweakInventory {_tweakInvSel :: Maybe Int}
| CombineInventory {_combineInvSel :: Maybe Int}
| InspectInventory
| LockedInventory
| DisplayTerminal {_termID :: Int }
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON SubInventory where
| DisplayTerminal {_termID :: Int}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON SubInventory where
toEncoding = genericToEncoding defaultOptions
instance FromJSON SubInventory
instance FromJSON SubInventory
data HUD = HUD
{ _hudElement :: HUDElement
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
{ _hudElement :: HUDElement
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON HUD where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON HUD where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HUD
instance FromJSON HUD
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
src/Dodge/Data/ItEffect.hs
-58
View File
@@ -1,58 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.ItEffect where
import GHC.Generics
import Data.Aeson
import Control.Lens
-- I believe this is called every frame, not sure when though
data ItEffect
= NoItEffect
| ItInvEffect
{_ieInv :: ItInvEffect --Item -> Creature -> World -> World
,_ieCounter :: Int
}
| ItRewindEffect
{_ieInv :: ItInvEffect --Item -> Creature -> World -> World
-- ,_ieStoredWorlds :: [World]
}
| ItEffect
{_ieInv :: ItInvEffect --Item -> Creature -> World -> World
,_ieFloor :: ItFloorEffect --Int -> World -> World
,_ieCounter :: Int
}
| ItInvEffectID
{_ieInv :: ItInvEffect --Item -> Creature -> World -> World
,_ieMID :: Maybe Int
} -- the duplication of ieMID may cause errors...
| ItInvEffectDrop
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieDrop :: ItDropEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItEffect
data ItInvEffect = NoInvEffect
| RewindEffect
| ResetAttachmentEffect
| OnOffHeldEffect ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
| RemoveShieldWall
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItInvEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItInvEffect
data ItFloorEffect = NoFloorEffect
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItFloorEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItFloorEffect
data ItDropEffect = NoDropEffect
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItDropEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItDropEffect
makeLenses ''ItEffect
src/Dodge/Data/Item.hs
+43 -42
View File
@@ -1,51 +1,52 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Item
( module Dodge.Data.Item
, module Dodge.Data.Item.Misc
, module Dodge.Data.Item.Tweak
, module Dodge.Data.Item.Params
, module Dodge.Data.Item.Use
, module Dodge.Data.Item.Consumption
, module Dodge.Data.Item.CurseStatus
, module Dodge.Data.Item.Attachment
) where
import GHC.Generics
import Data.Aeson
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item (
module Dodge.Data.Item,
module Dodge.Data.Item.Effect,
module Dodge.Data.Item.Misc,
module Dodge.Data.Item.Tweak,
module Dodge.Data.Item.Params,
module Dodge.Data.Item.Use,
module Dodge.Data.Item.CurseStatus,
module Dodge.Data.Item.Attachment,
module Dodge.Data.Item.Combine,
module Dodge.Data.Item.Targeting,
) where
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Combine
import Dodge.Data.Item.Effect
import Dodge.Data.Item.Attachment
import Dodge.Data.Item.CurseStatus
import Dodge.Data.Item.Misc
import Dodge.Data.Item.Tweak
import Dodge.Data.Item.Consumption
import Dodge.Data.Item.Use
import Dodge.Data.Item.Params
import Dodge.Data.ItEffect
import Dodge.Data.Targeting
import Dodge.Combine.Data
import Dodge.Data.Item.Attachment
import Color
import Dodge.Data.Item.Tweak
import Dodge.Data.Item.Use
import Dodge.Data.Item.Targeting
data Item = Item
{ _itConsumption :: ItemConsumption
, _itUse :: ItemUse
, _itType :: ItemType
{ _itUse :: ItemUse
, _itType :: ItemType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itPos :: ItemPos
, _itIsHeld :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
, _itInvColor :: Color
, _itTargeting :: Targeting
, _itDimension :: ItemDimension
, _itCurseStatus :: CurseStatus
, _itTweaks :: ItemTweaks
, _itScope :: Scope
, _itValue :: ItemValue
, _itParams :: ItemParams
, _itID :: Maybe Int
, _itPos :: ItemPos
, _itIsHeld :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
, _itInvColor :: Color
, _itTargeting :: Targeting
, _itDimension :: ItemDimension
, _itCurseStatus :: CurseStatus
, _itTweaks :: ItemTweaks
, _itScope :: Scope
, _itValue :: ItemValue
, _itParams :: ItemParams
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Item where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Item
deriving (Eq, Show, Read)
makeLenses ''Item
deriveJSON defaultOptions ''Item
src/Dodge/Data/Item/Attachment.hs
+36 -35
View File
@@ -1,43 +1,44 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Attachment
where
import GHC.Generics
import Data.Aeson
import Geometry.Data
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Attachment where
import Control.Lens
import qualified Data.Sequence as Seq
data ItAttachment
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data ItAttachment
= AttachFuse {_atFuseTime :: Int}
| AttachMode {_atMode :: Int}
| AttachCharMode {_atCharMode :: Seq.Seq Char }
| AttachTargetPos { _atTargetPos :: Point2 }
| AttachInt { _atInt :: Int }
| AttachMInt { _atMInt :: Maybe Int }
| AttachFloat { _atFloat :: Float }
| AttachBool { _atBool :: Bool }
| AttachTargetPos {_atTargetPos :: Point2}
| AttachInt {_atInt :: Int}
| AttachMInt {_atMInt :: Maybe Int}
| AttachFloat {_atFloat :: Float}
| AttachBool {_atBool :: Bool}
| NoItAttachment
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItAttachment where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItAttachment
data Scope = NoScope
| RemoteScope
{_scopePos :: Point2 -- ^ a camera offset
,_scopeZoom :: Float
,_scopeIsCamera :: Bool -- ^ if the camera offset is also the center of vision
deriving (Eq, Ord, Show, Read)
data Scope
= NoScope
| RemoteScope
{ -- | a camera offset
_scopePos :: Point2
, _scopeZoom :: Float
, -- | if the camera offset is also the center of vision
_scopeIsCamera :: Bool
}
| ZoomScope
{_scopePos :: Point2 -- ^ a camera offset
,_scopeZoomChange :: Int
,_scopeZoom :: Float
,_scopeDefaultZoom :: Float
,_scopeIsCamera :: Bool -- ^ if the camera offset is also the center of vision
| 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,Ord,Show,Read,Generic)
instance ToJSON Scope where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Scope
deriving (Eq, Ord, Show, Read)
makeLenses ''ItAttachment
makeLenses ''Scope
deriveJSON defaultOptions ''ItAttachment
deriveJSON defaultOptions ''Scope
src/Dodge/Combine/Data.hs → src/Dodge/Data/Item/Combine.hs
+74 -94
View File
@@ -1,28 +1,25 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Combine.Data
where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Equipment.Misc
import Dodge.Data.ItemAmount
module Dodge.Data.Item.Combine where
import Dodge.Data.Item.Use.Consumption
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
-- this should probably store loaded ammo
data ItemType = ItemType
{_iyBase :: ItemBaseType
,_iyModules :: M.Map ModuleSlot ItemModuleType
,_iyStack :: Stack
import Dodge.Data.Equipment.Misc
data ItemType = ItemType
{ _iyBase :: ItemBaseType
, _iyModules :: M.Map ModuleSlot ItemModuleType
, _iyStack :: Stack
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemType
data Stack = NoStack | Stack IcAmount
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Stack where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Stack
deriving (Eq, Ord, Show, Read)
data Stack = NoStack | Stack ItAmount
deriving (Eq, Ord, Show, Read)
data CraftType
= PIPE
| TUBE
@@ -47,7 +44,7 @@ data CraftType
| MICROCHIP
| AIUNIT
| CAMERA
| MINIDISPLAY -- visual display unit
| MINIDISPLAY -- visual display unit
| LED
| NAILBOX
| IRONBAR
@@ -59,8 +56,6 @@ data CraftType
| BATTERY
| FUELCELL
| PORTABLEFUSION
-- Modules
-- bullet
| INCENDIARYMODULE
| STATICMODULE
| CONCUSSMODULE
@@ -68,38 +63,24 @@ data CraftType
| FLASHMODULE
| BOUNCEMODULE
| PENMODULE
--
| TELEPORTMODULE
| TIMEMODULE
| SIZEMODULE
| GRAVITYMODULE
deriving (Eq,Ord,Show,Enum,Read,Generic)
instance ToJSON CraftType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CraftType
-- TODO make this an enum somehow...?
deriving (Eq, Ord, Show, Enum, Read)
data ItemBaseType
= NOTDEFINED
| EFFGUN String
| AUTOEFFGUN String
-- Weapons
| HELD {_ibtHeld :: HeldItemType}
= HELD {_ibtHeld :: HeldItemType}
| LEFT {_ibtLeft :: LeftItemType}
| EQUIP {_ibtEquip :: EquipItemType}
-- | GRENADE
-- | REMOTEBOMB
-- Utility items
-- Equipment
--
| KEYCARD Int
--
| MEDKIT Int
| Consumable {_ibtConsumable :: ConsumableItemType}
| CRAFT CraftType
--
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemBaseType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemBaseType
deriving (Eq, Ord, Show, Read)
data ConsumableItemType
= MEDKIT Int
deriving (Eq, Ord, Show, Read)
data EquipItemType
= MAGSHIELD
| FLAMESHIELD
@@ -115,10 +96,8 @@ data EquipItemType
| JUMPLEGS
| JETPACK
| AUTODETECTOR Detector
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON EquipItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EquipItemType
deriving (Eq, Ord, Show, Read)
data LeftItemType
= BOOSTER
| REWINDER
@@ -126,10 +105,8 @@ data LeftItemType
| BLINKERUNSAFE
| SHRINKER
| SPAWNER
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON LeftItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON LeftItemType
deriving (Eq, Ord, Show, Read)
data HeldItemType
= BANGSTICK {_xNum :: Int}
| PISTOL
@@ -141,18 +118,17 @@ data HeldItemType
| BANGCONE
| BLUNDERBUSS
| GRAPECANNON {_xNum :: Int}
-- | GRENADELAUNCHER Int -- number of chambers that can be reloaded
-- | MORTARCONE / HANDMORTAR
-- | MINIGUN
| MINIGUNX {_xNum :: Int}
| -- | GRENADELAUNCHER Int -- number of chambers that can be reloaded
-- | MORTARCONE / HANDMORTAR
MINIGUNX {_xNum :: Int}
| VOLLEYGUN {_xNum :: Int}
| RIFLE
| REPEATER
| AUTORIFLE
| BURSTRIFLE
-- | FASTBURSTRIFLE
-- | COMPLETEBURSTRIFLE
| BANGROD
| -- | FASTBURSTRIFLE
-- | COMPLETEBURSTRIFLE
BANGROD
| ELEPHANTGUN
| AMR
| AUTOAMR
@@ -167,34 +143,31 @@ data HeldItemType
| TESLAGUN
| LASGUN
| LASCIRCLE
-- | LASPULSE
| DUALBEAM
-- | LASGUNSWING
-- | LASGUNSWAY
-- | LASGUNWIDEPULSE
| LASWIDE {_xNum :: Int}
-- | LASGUNFOCUS Int
-- | SONICGUN
| TRACTORGUN
| -- | LASPULSE
DUALBEAM
| -- | LASGUNSWING
-- | LASGUNSWAY
-- | LASGUNWIDEPULSE
LASWIDE {_xNum :: Int}
| -- | LASGUNFOCUS Int
-- | SONICGUN
TRACTORGUN
| LAUNCHER
| LAUNCHERX {_xNum :: Int}
-- | TRACKINGLAUNCHER
| REMOTELAUNCHER
| -- | TRACKINGLAUNCHER
REMOTELAUNCHER
| POISONSPRAYER
| DRONELAUNCHER
| SHATTERGUN
| FORCEFIELDGUN
| HELDDETECTOR Detector
| TORCH
| FLATSHIELD
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON HeldItemType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldItemType
data ItemModuleType
| KEYCARD Int
deriving (Eq, Ord, Show, Read)
data ItemModuleType
= EMPTYMODULE
| DRUMMAG
| BELTMAG
@@ -204,7 +177,7 @@ data ItemModuleType
| PENBUL
| STATICBUL
| CONCUSBUL
| TARGCR
| TARGCR
| TARGLAS
| TARGPOS
| MAGNETTRAJ
@@ -217,18 +190,14 @@ data ItemModuleType
| LAUNCHHOME
| EXTRABATTERY
| ATTACHTORCH
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemModuleType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemModuleType
deriving (Eq, Ord, Show, Read)
data Detector
= ITEMDETECTOR
| CREATUREDETECTOR
| WALLDETECTOR
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Detector where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Detector
deriving (Eq, Ord, Show, Read)
data ModuleSlot
= ModBullet
| ModBulletSpawn
@@ -241,12 +210,23 @@ data ModuleSlot
| ModTeleport
| ModDualBeam
| ModHeldAttach
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ModuleSlot where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ModuleSlot
deriving (Eq, Ord, Show, Read)
instance ToJSONKey ModuleSlot
instance FromJSONKey ModuleSlot
deriveJSON defaultOptions ''ItemType
deriveJSON defaultOptions ''Stack
deriveJSON defaultOptions ''CraftType
deriveJSON defaultOptions ''ItemBaseType
deriveJSON defaultOptions ''ConsumableItemType
deriveJSON defaultOptions ''EquipItemType
deriveJSON defaultOptions ''LeftItemType
deriveJSON defaultOptions ''HeldItemType
deriveJSON defaultOptions ''ItemModuleType
deriveJSON defaultOptions ''Detector
deriveJSON defaultOptions ''ModuleSlot
makeLenses ''ItemType
makeLenses ''ItemBaseType
makeLenses ''HeldItemType
src/Dodge/Data/Item/Consumption.hs
-38
View File
@@ -1,38 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Item.Consumption where
import GHC.Generics
import Data.Aeson
import Control.Lens
import Dodge.Data.Ammo
import Dodge.Data.LoadAction
import Dodge.Data.ItemAmount
data ItemConsumption
= LoadableAmmo
{ _laAmmoType :: AmmoType
, _laMax :: Int
, _laLoaded :: Int
, _laPrimed :: Bool
, _laCycle :: [LoadAction]
, _laProgress :: Maybe [LoadAction]
}
| AutoRecharging
{ _arLoaded :: Int
, _arMax :: Int
, _arTime :: Int
, _arProgress :: Int
}
| ChargeableAmmo
{ _wpMaxCharge :: Int
, _wpCharge :: Int
}
| ItemItselfConsumable
{ _icAmount :: IcAmount
}
| NoConsumption
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemConsumption where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemConsumption
makeLenses ''ItemConsumption
src/Dodge/Data/Item/Effect.hs
+55
View File
@@ -0,0 +1,55 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Effect where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
data ItEffect
= NoItEffect
| ItInvEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieCounter :: Int
}
| ItRewindEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
}
| ItEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieFloor :: ItFloorEffect --Int -> World -> World
, _ieCounter :: Int
}
| ItInvEffectID
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int
} -- the duplication of ieMID may cause errors...
| ItInvEffectDrop
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieDrop :: ItDropEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int
}
deriving (Eq, Ord, Show, Read)
data ItInvEffect
= NoInvEffect
| RewindEffect
| ResetAttachmentEffect
| OnOffHeldEffect ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
| RemoveShieldWall
deriving (Eq, Ord, Show, Read)
data ItFloorEffect = NoFloorEffect
deriving (Eq, Ord, Show, Read)
data ItDropEffect = NoDropEffect
deriving (Eq, Ord, Show, Read)
makeLenses ''ItEffect
deriveJSON defaultOptions ''ItEffect
deriveJSON defaultOptions ''ItInvEffect
deriveJSON defaultOptions ''ItFloorEffect
deriveJSON defaultOptions ''ItDropEffect
src/Dodge/Data/Item/HeldScroll.hs
+20 -7
View File
@@ -1,10 +1,23 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.HeldScroll where
import GHC.Generics
import Control.Lens
import Data.Aeson
data HeldScroll = HeldScrollDoNothing | HeldScrollZoom | HeldScrollCharMode
deriving (Eq,Ord,Enum,Bounded,Show,Read,Generic)
instance ToJSON HeldScroll where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldScroll
import Data.Aeson.TH
import qualified Data.Sequence as Seq
data HeldScroll
= HeldScrollDoNothing
| HeldScrollZoom
| HeldScrollCharMode
{_hsCharMode :: Seq.Seq Char}
| HeldScrollInt
{ _hsInt :: Int
, _hsMaxInt :: Int
}
deriving (Eq, Ord, Show, Read)
makeLenses ''HeldScroll
deriveJSON defaultOptions ''HeldScroll
src/Dodge/Data/Item/HeldUse.hs
+13 -32
View File
@@ -1,12 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.HeldUse where
import Data.Aeson
import Dodge.Combine.Data
import Data.Aeson.TH
import Dodge.Data.CamouflageStatus
import GHC.Generics
import Dodge.Data.Item.Combine
data HeldUse
= HeldDoNothing
@@ -24,22 +24,12 @@ data HeldUse
| HeldTractor
| HeldForceField
| HeldShatter
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON HeldUse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldUse
deriving (Eq, Ord, Show, Read)
data Cuse
= CDoNothing
| CHeal Int
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Cuse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Cuse
deriving (Eq, Ord, Show, Read)
data Euse
= EDoNothing
@@ -50,12 +40,7 @@ data Euse
| ECamouflage CamouflageStatus
| EonWristShield
| EoffWristShield
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Euse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Euse
deriving (Eq, Ord, Show, Read)
data Luse
= LDoNothing
@@ -64,12 +49,7 @@ data Luse
| LBlink
| LUnsafeBlink
| LBoost
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Luse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Luse
deriving (Eq, Ord, Show, Read)
data HeldMod
= HeldModNothing
@@ -107,9 +87,10 @@ data HeldMod
| RevolverXMod
| RevolverXRepeatMod
| BangConeMod
deriving (Eq, Ord, Show, Read, Generic)
deriving (Eq, Ord, Show, Read)
instance ToJSON HeldMod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldMod
deriveJSON defaultOptions ''Cuse
deriveJSON defaultOptions ''HeldMod
deriveJSON defaultOptions ''Euse
deriveJSON defaultOptions ''HeldUse
deriveJSON defaultOptions ''Luse
src/Dodge/Data/Item/Params.hs
+55 -47
View File
@@ -1,22 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Params where
import GHC.Generics
import Data.Aeson
import Dodge.Data.Beam
import Dodge.Data.ArcStep
import Geometry.Data
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.ArcStep
import Dodge.Data.Beam
import Geometry.Data
data ItemParams
= NoParams
| ShellLauncher
{ _shellSpinDrag :: Int
, _shellSpinAmount :: Int
{ _shellSpinDrag :: Int
, _shellSpinAmount :: Int
, _shellThrustDelay :: Int
}
| Refracting
| Refracting
{ _phaseV :: Float
, _lasColor :: Color
, _lasColor2 :: Color
@@ -31,77 +33,83 @@ data ItemParams
, _lasDamage :: Int
, _lasBeam :: BeamType
, _subParams :: Maybe ItemParams
, _dbGap :: Float
, _dbGap :: Float
}
| Attracting {_attractionPower :: Point2}
| Attracting {_attractionPower :: Point2}
| BulletShooter
{ _muzVel :: Float
, _rifling :: Float
, _bore :: Float
{ _muzVel :: Float
, _rifling :: Float
, _bore :: Float
, _gunBarrels :: GunBarrels
, _recoil :: Float
, _torqueAfter :: Float
, _recoil :: Float
, _torqueAfter :: Float
, _randomOffset :: Float
}
| Sprayer { _sprayNozzles :: [Nozzle] }
| Sprayer {_sprayNozzles :: [Nozzle]}
| AngleWalk
{ _maxWalkAngle :: Float
, _currentWalkAngle :: Float
, _walkSpeed :: Float
}
| Arcing
{ _currentArc :: Maybe [ArcStep]
| Arcing
{ _currentArc :: Maybe [ArcStep]
, _arcSize :: Float
, _arcNumber :: Int
, _newArcStep :: NextArcStep --ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
, _previousArcEffect :: PreviousArcEffect
}
| ParamMID {_paramMID :: Maybe Int}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemParams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemParams
| BoostPropIX {_boostPropIX :: Maybe Int}
deriving (Eq, Ord, Show, Read)
data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON PreviousArcEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON PreviousArcEffect
deriving (Eq, Ord, Show, Read)
data GunBarrels
= MultiBarrel
{ _brlSpread :: BarrelSpread
, _brlNum :: Int
{ _brlSpread :: BarrelSpread
, _brlNum :: Int
, _brlInaccuracy :: Float
}
| RotBarrel
{ _brlNum :: Int
{ _brlNum :: Int
, _brlInaccuracy :: Float
}
| SingleBarrel {_brlInaccuracy :: Float}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON GunBarrels where
toEncoding = genericToEncoding defaultOptions
instance FromJSON GunBarrels
| SingleBarrel {_brlInaccuracy :: Float}
deriving (Eq, Ord, Show, Read)
data Nozzle = Nozzle
{ _nzPressure :: Float
, _nzDir :: Float
, _nzMaxWalkAngle :: Float
, _nzCurrentWalkAngle :: Float
, _nzWalkSpeed :: Float
, _nzLength :: Float
, _nzWalkSpeed :: Float
, _nzLength :: Float
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Nozzle where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Nozzle
deriving (Eq, Ord, Show, Read)
data BarrelSpread
= AlignedBarrels
| SpreadBarrels {_spreadAngle :: Float}
| SpreadBarrels {_spreadAngle :: Float}
| RotatingBarrels {_rotatingBarrelInaccuracy :: Float}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON BarrelSpread where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BarrelSpread
deriving (Eq, Ord, Show, Read)
makeLenses ''BarrelSpread
makeLenses ''ItemParams
makeLenses ''Nozzle
makeLenses ''GunBarrels
deriveJSON defaultOptions ''ItemParams
deriveJSON defaultOptions ''PreviousArcEffect
deriveJSON defaultOptions ''GunBarrels
deriveJSON defaultOptions ''Nozzle
deriveJSON defaultOptions ''BarrelSpread
src/Dodge/Data/Item/Targeting.hs
+40
View File
@@ -0,0 +1,40 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Targeting where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data Targeting
= NoTargeting
| Targeting
{ _tgPos :: Maybe Point2
, _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
, _tgDraw :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
, _tgID :: Maybe Int
, _tgActive :: Bool
}
deriving (Eq, Ord, Show, Read)
data TargetUpdate
= NoTargetUpdate
| TargetLaserUpdate
| TargetRBPressUpdate
| TargetRBCreatureUpdate
| TargetCursorUpdate
deriving (Eq, Ord, Show, Read)
data TargetDraw
= NoTargetDraw
| TargetDistanceDraw
| SimpleDrawTarget
| TargetRBCreatureDraw
deriving (Eq, Ord, Show, Read)
makeLenses ''Targeting
deriveJSON defaultOptions ''Targeting
deriveJSON defaultOptions ''TargetUpdate
deriveJSON defaultOptions ''TargetDraw
src/Dodge/Data/Item/Tweak.hs
-1
View File
@@ -10,7 +10,6 @@ data ItemTweaks
= NoTweaks
| Tweakable
{ _tweakParams :: IM.IntMap TweakParam
, _tweakSel :: Int
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemTweaks where
src/Dodge/Data/Item/Use.hs
+20 -19
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -8,16 +7,18 @@ module Dodge.Data.Item.Use (
module Dodge.Data.Item.HeldUse,
module Dodge.Data.Item.HeldScroll,
module Dodge.Data.Item.UseDelay,
module Dodge.Data.Item.Use.Consumption,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Hammer
import Dodge.Data.Item.HeldScroll
import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.Use.Consumption
import Dodge.Data.Item.Use.Equipment
import Dodge.Data.Item.UseDelay
import GHC.Generics
data ItemUse
= RightUse
@@ -27,24 +28,26 @@ data ItemUse
, _useHammer :: HammerPosition
, _useAim :: AimParams
, _heldScroll :: HeldScroll
, _heldConsumption :: HeldConsumption
}
| LeftUse
{ _lUse :: Luse
, _useDelay :: UseDelay
, _useHammer :: HammerPosition
, _eqEq :: Equipment
, _leftConsumption :: LeftConsumption
}
| ConsumeUse
{ _cUse :: Cuse
, _useAmount :: ItAmount
}
| EquipUse
{ _eqEq :: Equipment
}
| NoUse
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ItemUse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemUse
| CraftUse
{_useAmount :: ItAmount}
deriving (Eq, Show, Read)
data AimParams = AimParams
{ _aimWeight :: Int
, _aimRange :: Float
@@ -53,28 +56,26 @@ data AimParams = AimParams
, _aimHandlePos :: Float
, _aimMuzPos :: Float
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON AimParams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AimParams
deriving (Eq, Ord, Show, Read)
data AimStance
= TwoHandTwist
| TwoHandFlat
| OneHand
| LeaveHolstered
deriving (Eq, Show, Ord, Enum, Read, Generic)
instance ToJSON AimStance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AimStance
deriving (Eq, Show, Ord, Enum, Read)
data ItZoom = ItZoom
{ _itZoomMax :: Float
, _itZoomMin :: Float
, _itZoomFac :: Float
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ItZoom where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItZoom
deriving (Eq, Ord, Show, Read)
makeLenses ''ItemUse
makeLenses ''AimParams
makeLenses ''ItZoom
deriveJSON defaultOptions ''ItemUse
deriveJSON defaultOptions ''AimParams
deriveJSON defaultOptions ''AimStance
deriveJSON defaultOptions ''ItZoom
src/Dodge/Data/Item/Use/Consumption.hs
+46
View File
@@ -0,0 +1,46 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Consumption where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Ammo
import Dodge.Data.LoadAction
data HeldConsumption
= LoadableAmmo
{ _laAmmoType :: AmmoType
, _laMax :: Int
, _laLoaded :: Int
, _laPrimed :: Bool
, _laCycle :: [LoadAction]
, _laProgress :: Maybe [LoadAction]
}
| NoConsumption
deriving (Eq, Show, Read)
data LeftConsumption
= AutoRecharging
{ _arLoaded :: Int
, _arMax :: Int
, _arTime :: Int
, _arProgress :: Int
}
| ChargeableAmmo
{ _wpMaxCharge :: Int
, _wpCharge :: Int
}
deriving (Eq, Show, Read)
newtype ItAmount = ItAmount {_getItAmount :: Int}
deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
makeLenses ''HeldConsumption
makeLenses ''LeftConsumption
makeLenses ''ItAmount
deriveJSON defaultOptions ''HeldConsumption
deriveJSON defaultOptions ''LeftConsumption
deriveJSON defaultOptions ''ItAmount
src/Dodge/Data/ItemAmount.hs
-10
View File
@@ -1,10 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Dodge.Data.ItemAmount where
import GHC.Generics
import Data.Aeson
newtype IcAmount = IcAmount {_toInt :: Int}
deriving (Eq,Ord,Num,Integral,Real,Enum,Read,Show,Generic)
instance ToJSON IcAmount where
toEncoding = genericToEncoding defaultOptions
instance FromJSON IcAmount
src/Dodge/Data/Machine.hs
+52 -40
View File
@@ -1,61 +1,73 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Machine
where
import GHC.Generics
import Data.Aeson
import Dodge.Data.GenParams
import Dodge.Data.Item
import Sound.Data
import Dodge.Data.Object
import Dodge.Data.Damage
import Dodge.Data.Sensor
import Geometry.Data
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine where
import Color
import Dodge.Data.Material
import Control.Lens
import Data.Aeson
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Control.Lens
data MachineDraw = MachineDrawMempty
import Dodge.Data.Damage
import Dodge.Data.GenParams
import Dodge.Data.Item
import Dodge.Data.Material
import Dodge.Data.Object
import Dodge.Data.Sensor
import GHC.Generics
import Geometry.Data
import Sound.Data
data MachineDraw
= MachineDrawMempty
| MachineDrawTerminal
| MachineDrawTurret
| MachineDrawDamageSensor Float (PaletteColor,DecorationShape)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MachineDraw where
| MachineDrawDamageSensor Float (PaletteColor, DecorationShape)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON MachineDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MachineDraw
instance FromJSON MachineDraw
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
, _mcDraw :: MachineDraw --Machine -> SPic
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
, _mcDraw :: MachineDraw --Machine -> SPic
, _mcMaterial :: Material
, _mcPos :: Point2
, _mcDir :: Float
, _mcColor :: Color
, _mcHP :: Int
, _mcPos :: Point2
, _mcDir :: Float
, _mcColor :: Color
, _mcHP :: Int
, _mcSensor :: Sensor
, _mcDamage :: [Damage]
, _mcType :: MachineType
, _mcType :: MachineType
, _mcMounts :: M.Map ObjectType Int
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Machine where
deriving (Eq, Show, Read, Generic)
instance ToJSON Machine where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Machine
data MachineType
instance FromJSON Machine
data MachineType
= StaticMachine
| Turret
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuMCrID :: Maybe Int
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuMCrID :: Maybe Int
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MachineType where
deriving (Eq, Show, Read, Generic)
instance ToJSON MachineType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MachineType
instance FromJSON MachineType
makeLenses ''Machine
makeLenses ''MachineType
src/Dodge/RoomCluster/Data.hs → src/Dodge/Data/RoomCluster.hs
+6 -4
View File
@@ -1,8 +1,10 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.RoomCluster.Data where
import qualified Data.Set as S
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.RoomCluster where
import Control.Lens
import qualified Data.Set as S
data ClusterStatus = ClusterStatus
{ _csName :: String
@@ -10,6 +12,6 @@ data ClusterStatus = ClusterStatus
}
data ClusterLink = OnwardCluster | SideCluster | LabelCluster Int
deriving (Ord,Eq,Show)
deriving (Ord, Eq, Show)
makeLenses ''ClusterStatus
src/Dodge/Data/Sensor.hs
+21 -21
View File
@@ -1,40 +1,40 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Sensor where
import GHC.Generics
import Data.Aeson
import Dodge.Combine.Data
import Dodge.Data.Damage.Type
import Control.Lens
data Sensor = NoSensor
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Combine
import Dodge.Data.Damage.Type
data Sensor
= NoSensor
| DamageSensor
{ _sensToggle :: Bool
, _sensAmount :: Int
, _sensType :: DamageType
, _sensType :: DamageType
}
| ProximitySensor
{ _proxStatus :: CloseToggle
{ _proxStatus :: CloseToggle
, _proxDist :: Float
, _proxRequirement :: ProximityRequirement
, _sensToggle :: Bool
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Sensor where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Sensor
deriving (Eq, Ord, Show, Read)
data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemBaseType}
| RequireImpossible
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ProximityRequirement where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProximityRequirement
deriving (Eq, Ord, Show, Read)
data CloseToggle = NotClose | IsClose
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON CloseToggle where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CloseToggle
deriving (Eq, Ord, Show, Read)
makeLenses ''Sensor
makeLenses ''ProximityRequirement
deriveJSON defaultOptions ''Sensor
deriveJSON defaultOptions ''ProximityRequirement
deriveJSON defaultOptions ''CloseToggle
src/Dodge/Data/Targeting.hs
-39
View File
@@ -1,39 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Targeting where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
data Targeting
= NoTargeting
| Targeting
{ _tgPos :: Maybe Point2
, _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
, _tgDraw :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
, _tgID :: Maybe Int
, _tgActive :: Bool
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Targeting where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Targeting
data TargetUpdate = NoTargetUpdate
| TargetLaserUpdate
| TargetRBPressUpdate
| TargetRBCreatureUpdate
| TargetCursorUpdate
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TargetUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TargetUpdate
data TargetDraw = NoTargetDraw
| TargetDistanceDraw
| SimpleDrawTarget
| TargetRBCreatureDraw
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TargetDraw where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TargetDraw
makeLenses ''Targeting
src/Dodge/Data/Terminal.hs
+112 -70
View File
@@ -1,134 +1,176 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Terminal
where
import GHC.Generics
import Data.Aeson
import Dodge.Data.WorldEffect
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Terminal where
import Color
import Control.Lens
import qualified Data.Text as T
import Data.Aeson
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Dodge.Data.WorldEffect
import GHC.Generics
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalStatus where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON TerminalStatus where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalStatus
instance FromJSON TerminalStatus
data TerminalInput = TerminalInput
{ _tiText :: T.Text
, _tiFocus :: Bool
, _tiSel :: (Int,Int)
{ _tiText :: T.Text
, _tiFocus :: Bool
, _tiSel :: (Int, Int)
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalInput where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON TerminalInput where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalInput
data TerminalBootProgram = TerminalBootMempty
instance FromJSON TerminalInput
data TerminalBootProgram
= TerminalBootMempty
| TerminalBootLines [TerminalLine]
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalBootProgram where
deriving (Eq, Show, Read, Generic)
instance ToJSON TerminalBootProgram where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalBootProgram
instance FromJSON TerminalBootProgram
data Terminal = Terminal
{ _tmID :: Int
, _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmDisplayedLines :: [(String,Color)]
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: TerminalInput
{ _tmID :: Int
, _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmDisplayedLines :: [(String, Color)]
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: TerminalInput
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: TmWdWd -- Terminal -> World -> World
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: TmWdWd -- Terminal -> World -> World
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Terminal where
deriving (Eq, Show, Read, Generic)
instance ToJSON Terminal where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Terminal
instance FromJSON Terminal
data TerminalLineString = TerminalLineConst String Color
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalLineString where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON TerminalLineString where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalLineString
data TmTm = TmId
instance FromJSON TerminalLineString
data TmTm
= TmId
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TmTm where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON TmTm where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TmTm
instance FromJSON TmTm
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: TerminalLineString -- World -> (String, Color)
{ _tlPause :: Int
, _tlString :: TerminalLineString -- World -> (String, Color)
}
| TerminalLineTerminalEffect
{_tlPause :: Int
,_tlTermEffect :: TmTm -- Terminal -> Terminal
{ _tlPause :: Int
, _tlTermEffect :: TmTm -- Terminal -> Terminal
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: TmWdWd --Terminal -> World -> World
{ _tlPause :: Int
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Show, Read, Generic)
instance ToJSON TerminalLine where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalLine
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: BlBl
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalToggle where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON TerminalToggle where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalToggle
data BlBl = BlNegate
instance FromJSON TerminalToggle
data BlBl
= BlNegate
| BlConst Bool
| BlId
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON BlBl where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON BlBl where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BlBl
instance FromJSON BlBl
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument
{_argType :: String
,_argList :: M.Map String [TerminalLine]
| OneArgument
{ _argType :: String
, _argList :: M.Map String [TerminalLine]
}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Show, Read, Generic)
instance ToJSON EffectArguments where
toEncoding = genericToEncoding defaultOptions
instance FromJSON EffectArguments
data TerminalCommandEffect = TerminalCommandArguments EffectArguments
data TerminalCommandEffect
= TerminalCommandArguments EffectArguments
| TerminalCommandEffectDamageCoding
| TerminalCommandEffectSensorParameter
| TerminalCommandEffectLinkedObject
| TerminalCommandEffectLinkedObject
| TerminalCommandEffectHelp
| TerminalCommandEffectNoArgumentsStr String
| TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalCommandEffect where
deriving (Eq, Show, Read, Generic)
instance ToJSON TerminalCommandEffect where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalCommandEffect
instance FromJSON TerminalCommandEffect
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TerminalCommand where
deriving (Eq, Show, Read, Generic)
instance ToJSON TerminalCommand where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TerminalCommand
instance FromJSON TerminalCommand
makeLenses ''TerminalInput
makeLenses ''Terminal
makeLenses ''TerminalLine
src/Dodge/Data/WorldEffect.hs
+78 -45
View File
@@ -1,24 +1,31 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.WorldEffect where
import Dodge.Data.Item
import Data.Aeson
import GHC.Generics
import Dodge.Data.CreatureEffect
import Sound.Data
import Geometry.Data
import Dodge.Data.SoundOrigin
data ItCrWdWd = ItCrWdId
| ItCrWdItemEffect
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItCrWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItCrWdWd
data WdWd = NoWorldEffect
| SetTrigger Bool Int
module Dodge.Data.WorldEffect where
import Data.Aeson
import Dodge.Data.CreatureEffect
import Dodge.Data.Item
import Dodge.Data.SoundOrigin
import GHC.Generics
import Geometry.Data
import Sound.Data
data ItCrWdWd
= ItCrWdId
| ItCrWdItemEffect
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ItCrWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItCrWdWd
data WdWd
= NoWorldEffect
| SetTrigger Bool Int
| WorldEffects [WdWd]
| SetLSCol Point3 Int
| AccessTerminal (Maybe Int)
@@ -29,55 +36,81 @@ data WdWd = NoWorldEffect
| WdWdNegateTrig Int
| WdWdFromItixCrixWdWd Int Int ItCrWdWd
| WdWdFromItCrixWdWd Item Int ItCrWdWd
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON WdWd where
deriving (Eq, Show, Read, Generic)
instance ToJSON WdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WdWd
data WdP2 = WdP2Const Point2
instance FromJSON WdWd
data WdP2
= WdP2Const Point2
| WdYouPos
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON WdP2 where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON WdP2 where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WdP2
data MdWdWd = MdWdId
instance FromJSON WdP2
data MdWdWd
= MdWdId
| MdTrigIf MdWdWd MdWdWd
| MdSetLSCol Point3
| MdFlickerUpdate
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MdWdWd where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON MdWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MdWdWd
data WdBl = WdTrig Int
instance FromJSON MdWdWd
data WdBl
= WdTrig Int
| WdBlDoorMoving Int
| WdBlConst Bool
| WdBlNegate WdBl
| WdBlCrFilterNearPoint Float Point2 CrBl
| WdBlBtOn Int
| WdBlBtNotOff Int
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON WdBl where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON WdBl where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WdBl
data WdP2f = WdP2f0
instance FromJSON WdBl
data WdP2f
= WdP2f0
| WdP2fDoorPosition Int
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON WdP2f where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON WdP2f where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WdP2f
data DrWdWd = DrWdId
instance FromJSON WdP2f
data DrWdWd
= DrWdId
| DrWdMakeDoorDebris
| DrWdMechanismStepwise Int [Int] [(Point2,Point2)]
| DrWdMechanismStepwise Int [Int] [(Point2, Point2)]
| DoorMechanism
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON DrWdWd where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON DrWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON DrWdWd
data TmWdWd = TmWdId
instance FromJSON DrWdWd
data TmWdWd
= TmWdId
| TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TmWdWd where
deriving (Eq, Show, Read, Generic)
instance ToJSON TmWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TmWdWd
instance FromJSON TmWdWd
src/Dodge/Default.hs
+3 -3
View File
@@ -23,6 +23,7 @@ import Dodge.Data
import Dodge.SoundLogic
import Geometry
import Picture
import Control.Lens
defaultEquipment :: Item
defaultEquipment = defaultItem
@@ -34,9 +35,8 @@ defaultItZoom :: ItZoom
defaultItZoom = ItZoom 20 0.2 1
defaultConsumable :: Item
defaultConsumable = defaultItem
{ _itConsumption = ItemItselfConsumable {_icAmount = 1}
, _itInvColor = blue
}
& itUse .~ ConsumeUse CDoNothing 1
& itInvColor .~ blue
defaultFlIt :: FloorItem
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
src/Dodge/Default/Item.hs
+27 -27
View File
@@ -1,32 +1,32 @@
module Dodge.Default.Item
( defaultItem
) where
import Dodge.Data
import Picture
module Dodge.Default.Item (
defaultItem,
) where
import Dodge.Data.Item
import Geometry.Data
--import Shape
import Picture
defaultItem :: Item
defaultItem = Item
{ _itCurseStatus = Uncursed
, _itType = defaultItemType
-- , _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = NoItEffect
, _itID = Nothing
, _itIsHeld = False
, _itInvColor = yellow
, _itInvSize = 1
, _itPos = VoidItm
, _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
, _itConsumption = NoConsumption
, _itUse = NoUse
, _itAttachment = NoItAttachment
, _itParams = NoParams
, _itTweaks = NoTweaks
, _itScope = NoScope
, _itTargeting = NoTargeting
, _itValue = ItemValue 0 MundaneItem
}
defaultItem =
Item
{ _itCurseStatus = Uncursed
, _itType = defaultItemType
, -- , _itEquipPict = \_ _ -> (,) emptySH blank
_itEffect = NoItEffect
, _itID = Nothing
, _itIsHeld = False
, _itInvColor = yellow
, _itInvSize = 1
, _itPos = VoidItm
, _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
, _itUse = CraftUse (ItAmount 1)
, _itParams = NoParams
, _itTweaks = NoTweaks
, _itScope = NoScope
, _itTargeting = NoTargeting
, _itValue = ItemValue 0 MundaneItem
, _itAttachment = NoItAttachment
}
defaultItemType :: ItemType
defaultItemType = ItemType NOTDEFINED mempty NoStack
defaultItemType = ItemType (error "defaultItemType not initialized") mempty NoStack
src/Dodge/Default/Weapon.hs
+97 -78
View File
@@ -1,104 +1,123 @@
module Dodge.Default.Weapon
where
import Dodge.Data
import Dodge.Reloading.Action
import Dodge.Item.Weapon.Bullet
import Dodge.Default.Item
module Dodge.Default.Weapon where
import Control.Lens
import qualified Data.Map.Strict as M
import Dodge.Data.Ammo
import Dodge.Data.Hammer
import Dodge.Data.Item
import Dodge.Default.AimParams
--import Dodge.Item.Draw
import Dodge.Default.Item
import Dodge.Item.Weapon.Bullet
import Dodge.Reloading.Action
import Picture
import qualified Data.Map.Strict as M
import Control.Lens
defaultLeftLoadable :: ItemConsumption
defaultLeftLoadable :: LeftConsumption
defaultLeftLoadable = AutoRecharging 10 10 100 100
defaultLoadable :: ItemConsumption
defaultLoadable = LoadableAmmo
{ _laAmmoType = GenericAmmo
, _laMax = 15
, _laLoaded = 0
, _laPrimed = True
, _laCycle = [loadEject 10, loadInsert 10, loadPrime 10]
, _laProgress = Nothing
}
defaultBulletLoadable :: ItemConsumption
defaultLoadable :: HeldConsumption
defaultLoadable =
LoadableAmmo
{ _laAmmoType = GenericAmmo
, _laMax = 15
, _laLoaded = 0
, _laPrimed = True
, _laCycle = [loadEject 10, loadInsert 10, loadPrime 10]
, _laProgress = Nothing
}
defaultBulletLoadable :: HeldConsumption
defaultBulletLoadable = defaultLoadable & laAmmoType .~ basicBullet
defaultChargeable :: ItemConsumption
defaultChargeable :: LeftConsumption
defaultChargeable = ChargeableAmmo 100 100
defaultrUse :: ItemUse
defaultrUse = RightUse
{ _rUse = HeldDoNothing
, _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
, _useMods = HeldModNothing
, _useHammer = HammerUp
, _useAim = defaultAimParams
, _heldScroll = HeldScrollDoNothing
}
defaultrUse =
RightUse
{ _rUse = HeldDoNothing
, _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
, _useMods = HeldModNothing
, _useHammer = HammerUp
, _useAim = defaultAimParams
, _heldScroll = HeldScrollDoNothing
, _heldConsumption = defaultLoadable
}
defaultlUse :: ItemUse
defaultlUse = LeftUse
{ _lUse = LDoNothing
, _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
, _useHammer = HammerUp
, _eqEq = defaultEquip
}
defaultlUse =
LeftUse
{ _lUse = LDoNothing
, _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
, _useHammer = HammerUp
, _eqEq = defaultEquip
, _leftConsumption = defaultLeftLoadable
}
defaultEquip :: Equipment
defaultEquip = Equipment
{ _eqSite = GoesOnSpecial
, _eqUse = EDoNothing
, _eqOnEquip = EDoNothing
, _eqOnRemove = EDoNothing
, _eqParams = NoEquipParams
, _eqViewDist = Nothing
}
defaultEquip =
Equipment
{ _eqSite = GoesOnSpecial
, _eqUse = EDoNothing
, _eqOnEquip = EDoNothing
, _eqOnRemove = EDoNothing
, _eqParams = NoEquipParams
, _eqViewDist = Nothing
}
luseInstantNoH :: Luse -> ItemUse
luseInstantNoH f = defaultlUse
& lUse .~ f
& useDelay .~ NoDelay
luseInstantNoH f =
defaultlUse
& lUse .~ f
& useDelay .~ NoDelay
-- TODO change this
defaultLeftItem :: Item
defaultLeftItem = defaultWeapon
& itConsumption .~ defaultLeftLoadable
defaultLeftItem =
defaultWeapon
& itUse .~ defaultlUse
defaultWeapon :: Item
defaultWeapon = defaultItem
& itConsumption .~ defaultLoadable
& itUse .~ defaultrUse
& itInvColor .~ white
& itType . iyModules .~ M.fromList
[(ModTarget, EMPTYMODULE)
,(ModTeleport, EMPTYMODULE)
]
defaultWeapon =
defaultItem
& itUse .~ defaultrUse
& itInvColor .~ white
& itType . iyModules
.~ M.fromList
[ (ModTarget, EMPTYMODULE)
, (ModTeleport, EMPTYMODULE)
]
defaultBulletWeapon :: Item
defaultBulletWeapon = defaultWeapon
& itConsumption .~ defaultBulletLoadable
& itUse . rUse .~ HeldUseAmmoParams -- useAmmoParams
& itType . iyModules . at ModBullet ?~ EMPTYMODULE
& itType . iyModules . at ModBulletSpawn ?~ EMPTYMODULE
& itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
defaultBulletWeapon =
defaultWeapon
& itUse . heldConsumption .~ defaultBulletLoadable
& itUse . rUse .~ HeldUseAmmoParams -- useAmmoParams
& itType . iyModules . at ModBullet ?~ EMPTYMODULE
& itType . iyModules . at ModBulletSpawn ?~ EMPTYMODULE
& itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
defaultItemValue :: ItemValue
defaultItemValue = ItemValue 10 MundaneItem
defaultCraftable :: Item
defaultCraftable = defaultItem
{ _itInvColor = green
}
defaultCraftable =
defaultItem
{ _itInvColor = green
}
defBulletShooter :: ItemParams
defBulletShooter = BulletShooter
{ _muzVel = 1
, _rifling = 0.8
, _bore = 2
, _gunBarrels = SingleBarrel 0
, _recoil = 0
, _torqueAfter = 0
, _randomOffset = 0
}
defBulletShooter =
BulletShooter
{ _muzVel = 1
, _rifling = 0.8
, _bore = 2
, _gunBarrels = SingleBarrel 0
, _recoil = 0
, _torqueAfter = 0
, _randomOffset = 0
}
defaultAutoGun :: Item
defaultAutoGun = defaultBulletWeapon
& itUse . useAim . aimStance .~ TwoHandTwist
defaultAutoGun =
defaultBulletWeapon
& itUse . useAim . aimStance .~ TwoHandTwist
src/Dodge/Distortion.hs
+1 -1
View File
@@ -1,5 +1,5 @@
module Dodge.Distortion where
import Dodge.Distortion.Data
import Dodge.Data.Distortion
updateDistortion :: Distortion -> Maybe Distortion
updateDistortion dt = case dt of
src/Dodge/Distortion/Data.hs
-14
View File
@@ -1,14 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Distortion.Data where
import GHC.Generics
import Data.Aeson
import Geometry
data Distortion
= RadialDistortion Point2 Point2 Point2 Float
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Distortion where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Distortion
src/Dodge/Equipment.hs
+10 -5
View File
@@ -1,10 +1,15 @@
module Dodge.Equipment where
import Dodge.Data
--import Data.Strict.IntMap.Autogen.Merge.Strict
import Data.IntMap.Merge.Strict
import Dodge.Data
import qualified IntMapHelp as IM
import Data.Strict.IntMap.Autogen.Merge.Strict
--import Data.IntMap.Merge.Strict
getCrEquipment :: Creature -> IM.IntMap Item
getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id)
(_crInvEquipped cr) (_crInv cr)
getCrEquipment cr =
merge
dropMissing
dropMissing
(zipWithMatched $ \_ _ -> id)
(_crInvEquipped cr)
(_crInv cr)
src/Dodge/Event.hs
+98 -82
View File
@@ -11,44 +11,47 @@ Nor could we handle continuous mouse button input.
Instead we store button presses (in a Map) and deal with the combinations in
the simulation step; in particular see 'updatePressedButtons'.
-}
module Dodge.Event
( handleEvent
) where
import Dodge.Terminal
import Dodge.Tweak
import Dodge.HeldScroll
import Dodge.InputFocus
import Dodge.Combine
import Dodge.Event.Keyboard
import Dodge.Base
import Dodge.Data
import Dodge.PreloadData
import Dodge.Inventory
import Dodge.SoundLogic
import qualified IntMapHelp as IM
module Dodge.Event (
handleEvent,
) where
import Control.Lens
import Data.Maybe
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import Dodge.Base
import Dodge.Combine
import Dodge.Data
import Dodge.Event.Keyboard
import Dodge.HeldScroll
import Dodge.InputFocus
import Dodge.Inventory
import Dodge.PreloadData
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Tweak
import qualified IntMapHelp as IM
import SDL
handleEvent :: Event -> Universe -> IO (Maybe Universe)
handleEvent e = case eventPayload e of
TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
KeyboardEvent kev -> handleKeyboardEvent kev
MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
KeyboardEvent kev -> handleKeyboardEvent kev
MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
WindowSizeChangedEvent sev -> handleResizeEvent sev
WindowMovedEvent mev -> return . handleWindowMoveEvent mev
_ -> return . Just
WindowMovedEvent mev -> return . handleWindowMoveEvent mev
_ -> return . Just
handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
(fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y)
handleMouseMotionEvent mmev u =
Just $
u & uvWorld . mousePos
.~ V2
(fromIntegral x - 0.5 * _windowX cfig)
(0.5 * _windowY cfig - fromIntegral y)
where
cfig = _uvConfig u
P (V2 x y) = mouseMotionEventPos mmev
@@ -56,26 +59,30 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ False
Pressed -> mouseButtons . at thebutton ?~ False
where
thebutton = mouseButtonEventButton mbev
{- | Sets window position in config. -}
-- | Sets window position in config.
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
handleWindowMoveEvent mev = Just
. (uvConfig . windowPosX .~ fromIntegral x)
. (uvConfig . windowPosY .~ fromIntegral y)
handleWindowMoveEvent mev =
Just
. (uvConfig . windowPosX .~ fromIntegral x)
. (uvConfig . windowPosY .~ fromIntegral y)
where
P (V2 x y) = windowMovedEventPosition mev
{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -}
-- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.
-- using a sideeffect here for the io change seems to work better, more testing
-- later may be a good idea
handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
handleResizeEvent sev u = return . Just $ u
& uvConfig . windowX .~ fromIntegral x
& uvConfig . windowY .~ fromIntegral y
& uvIOEffects %~ sideEffectUpdatePreload divRes x y
handleResizeEvent sev u =
return . Just $
u
& uvConfig . windowX .~ fromIntegral x
& uvConfig . windowY .~ fromIntegral y
& uvIOEffects %~ sideEffectUpdatePreload divRes x y
where
x = fromIntegral x'
y = fromIntegral y'
@@ -91,44 +98,51 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
wheelEvent :: Float -> World -> World
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
| otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
DisplayInventory NoSubInventory
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
(_,EquipOptions{}) -> scrollRBOption y w
(Nothing,_) -> closeObjScrollDir y w
(Just f,_) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
(_, EquipOptions{}) -> scrollRBOption y w
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| lbDown -> w & cWorld . cameraZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory TweakInventory
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory (TweakInventory mi)
| invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
| rbDown -> w & changeTweakParam mi yi
| otherwise -> w & moveTweakSel yi
DisplayInventory CombineInventory{} ->
w
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tmid)
| rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
& cWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w -> w
& cWorld . terminals . ix tmid %~ updatetermsel
| rbDown && inTermFocus w ->
guardDisconnectedID tmid w $
w
& cWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w ->
w
& cWorld . terminals . ix tmid %~ updatetermsel
_ -> w
where
updatetermsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0,0)
Just (i,_) -> let newi = (i - yi) `mod` length (scrollCommands tm)
in tm & setInput newi 0 w
Nothing -> tm & tmInput . tiSel .~ (0, 0)
Just (i, _) ->
let newi = (i - yi) `mod` length (scrollCommands tm)
in tm & setInput newi 0 w
updatetermsubsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0,0)
Just (i,j) -> let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
in tm & setInput i newj w
setInput i j w' tm = tm
& tmInput . tiSel .~ (i,j)
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
Nothing -> tm & tmInput . tiSel .~ (0, 0)
Just (i, j) ->
let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
in tm & setInput i newj w
setInput i j w' tm =
tm
& tmInput . tiSel .~ (i, j)
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
where
tc = scrollCommands tm !! i
arg = getArguments' tc tm w' !! j
@@ -144,37 +158,39 @@ getArguments' tc tm = ("" :) . getArguments tc tm
getArguments :: TerminalCommand -> Terminal -> World -> [String]
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
NoArguments {} -> []
NoArguments{} -> []
OneArgument _ m -> M.keys m
scrollCommands :: Terminal -> [TerminalCommand]
scrollCommands = (nullCommand :) . _tmScrollCommands
nullCommand :: TerminalCommand
nullCommand = TerminalCommand
{ _tcString = ""
, _tcAlias = []
, _tcHelp = ""
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
}
nullCommand =
TerminalCommand
{ _tcString = ""
, _tcAlias = []
, _tcHelp = ""
, _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
}
scrollRBOption :: Float -> World -> World
scrollRBOption y w
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
| otherwise = w
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
. itTweaks . tweakSel %~ (`mod` length l) . subtract i
Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
_ -> w
changeTweakParam :: Int -> World -> World
changeTweakParam i w = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
. doTweak (_tweakType params) x)
where
tweaks = _itTweaks . fromJust $ yourItem w
params = _tweakParams tweaks IM.! paramid
x = (_tweakVal params + i) `mod` _tweakMax params
paramid = _tweakSel tweaks
changeTweakParam :: Maybe Int -> Int -> World -> World
changeTweakParam mi i w = fromMaybe w $ do
paramid <- mi
params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
let x = (_tweakVal params + i) `mod` _tweakMax params
return $
w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
. doTweak (_tweakType params) x
)
src/Dodge/Event/Keyboard.hs
+8 -5
View File
@@ -93,7 +93,7 @@ handlePressedKeyInGame scode uv = case scode of
ScancodeM -> over uvWorld toggleMap uv
ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv
_ -> uv
@@ -114,10 +114,13 @@ handlePressedKeyTerminal tmid scode w = case scode of
Nothing -> t
Just (t',_) -> t'
toggleTweakInv :: HUDElement -> HUDElement
toggleTweakInv he = case he of
DisplayInventory TweakInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory TweakInventory
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^. cWorld . hud . hudElement of
DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
_ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
where
thepointer = cWorld . hud . hudElement
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
toggleInspectInv :: HUDElement -> HUDElement
toggleInspectInv he = case he of
src/Dodge/FloorItem.hs
+1 -1
View File
@@ -28,7 +28,7 @@ copyItemToFloorID pos it w = (,) flid $ w'
_ -> id
flid = IM.newKey $ _floorItems (_cWorld w)
theflit = FlIt
{_flIt = it & itConsumption . icAmount %~ const 1
{_flIt = it & itUse . useAmount %~ const 1
,_flItPos = p'
,_flItRot = rot
,_flItID = flid
src/Dodge/HeldScroll.hs
+12 -24
View File
@@ -10,28 +10,16 @@ doHeldScroll :: HeldScroll -> Float -> Creature -> Item -> Item
doHeldScroll hs = case hs of
HeldScrollDoNothing -> const . const id
HeldScrollZoom -> zoomLongGun
HeldScrollCharMode -> scrollCharMode
scrollCharMode
:: Float -- ^ Amount scrolled
-> Creature
-> Item
-> Item
scrollCharMode x _
| x > 0 = incCharMode
| x < 0 = decCharMode
| otherwise = id
HeldScrollCharMode {} -> \ x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
HeldScrollInt {} -> undefined
incCharMode
:: Item
-> Item
incCharMode = itAttachment . atCharMode %~ cycleL
where
cycleL (x :<| xs) = xs |> x
cycleL xs = xs
decCharMode
:: Item
-> Item
decCharMode = itAttachment . atCharMode %~ cycleR
where
cycleR (xs :|> x) = x <| xs
cycleR xs = xs
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
src/Dodge/HeldUse.hs
+8 -8
View File
@@ -349,7 +349,7 @@ useMod hm = case hm of
where
p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
a = argV (mouseWorldPos w -.- p)
moddelay x = itConsumption . laAmmoType . amBullet . buState .~ DelayedBullet x
moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr)
& crPos %~ tweenPoints x (_crOldPos cr)
@@ -373,14 +373,14 @@ useHeld hu = case hu of
HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
usePjCreation :: Item -> Creature -> World -> World
usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it
usePjCreationX :: Int -> Item -> Creature -> World -> World
usePjCreationX i it cr = foldr f
(createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
(createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it cr)
[1..i-1]
where
f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
f n = (. createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
overNozzles :: (Nozzle -> Item -> Creature -> World -> World)
-> Item -> Creature -> World -> World
@@ -407,7 +407,7 @@ overNozzle eff it cr w nz =
wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
useGasParams :: Nozzle -> Item -> Creature -> World -> World
useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it)))
useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_heldConsumption (_itUse it))))
(_nzPressure nz) pos dir cr
where
dir = _crDir cr
@@ -430,18 +430,18 @@ fireRemoteShell it cr w = set (cWorld . creatures . ix cid . crInv . ix j . itUs
caneStickSoundChoice :: Item -> SoundID
caneStickSoundChoice it
| _laLoaded (_itConsumption it) < 2 = tap3S
| _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S
| otherwise = shotgunS
bangStickSoundChoice :: Item -> SoundID
bangStickSoundChoice it
| _laLoaded (_itConsumption it) < 2 = tap3S
| _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S
| otherwise = shotgunS
coneRandItemUpdate :: State StdGen (Item -> Item)
coneRandItemUpdate = do
wth <- state $ randomR (1,5)
return (itConsumption . laAmmoType . amBullet . buWidth .~ wth)
return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)
coneRandItemParams :: State StdGen (ItemParams -> ItemParams)
coneRandItemParams = do
muzv <- state $ randomR (0.5,1)
src/Dodge/Inventory.hs
+2 -2
View File
@@ -53,8 +53,8 @@ rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World
-> World
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
_ -> w
& cWorld . creatures . ix cid . crInv %~ f
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
src/Dodge/Inventory/Add.hs
+1 -1
View File
@@ -15,7 +15,7 @@ putItemInInvID cid flid w = fromMaybe (Nothing,w) $ do
return (Just i,w')
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
putItemInInvSlot = IM.insertWith (const $ itConsumption . icAmount +~ 1)
putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
{- | Pick up a specific item. -}
tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int,World)
src/Dodge/Inventory/CheckSlots.hs
+15 -14
View File
@@ -1,32 +1,33 @@
module Dodge.Inventory.CheckSlots where
import Dodge.Data
import Control.Lens
import Data.Maybe
import Dodge.Base.You
import Dodge.Data
import Dodge.Inventory.ItemSpace
import qualified IntMapHelp as IM
import Data.Maybe
--import Control.Lens
-- | checks whether or not an item will fit in your inventory
-- if so return Just the next slot to be used
{- | checks whether or not an item will fit in your inventory
if so return Just the next slot to be used
-}
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w
| crNumFreeSlots ycr >= ceiling (_itInvSize it)
= Just $ findItemSlot it inv
| crNumFreeSlots ycr >= ceiling (_itInvSize it) =
Just $ findItemSlot it inv
| otherwise = Nothing
where
where
ycr = you w
inv = _crInv ycr
-- Assumes that the item is singular.
-- Do not want to stack floor items for now
findItemSlot :: Item -> IM.IntMap Item -> Int
findItemSlot it inv = case _itConsumption it of
ItemItselfConsumable _
-> fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
_ -> newslot
findItemSlot it inv = case it ^? itUse . useAmount of
Just _ ->
fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
_ -> newslot
where
newslot = maybe 0 ((+1) . fst) $ IM.lookupMax inv
newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
src/Dodge/Inventory/ItemSpace.hs
+1 -1
View File
@@ -8,6 +8,6 @@ import Control.Lens
--import Data.Maybe
itSlotsTaken :: Item -> Int
itSlotsTaken it = case it ^? itConsumption . icAmount of
itSlotsTaken it = case it ^? itUse . useAmount of
Nothing -> moduleSizes it + ceiling (_itInvSize it)
Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)
src/Dodge/ItEffect.hs
+2 -2
View File
@@ -35,8 +35,8 @@ rewindEffect itm cr w
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itPos itm
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
maxcharge = _wpMaxCharge . _itConsumption $ itm
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
cw = _cWorld w
& rewindWorlds .~ []
src/Dodge/Item.hs
+4 -24
View File
@@ -5,31 +5,24 @@ module Dodge.Item
, module Dodge.Item.PassKey
, module Dodge.Item.Craftable
, itemFromBase
, baseToFamily
) where
import Dodge.Data
import Dodge.Item.Weapon
import Dodge.Item.Equipment
import Dodge.Item.Consumable
import Dodge.Item.PassKey
import Dodge.Item.Family
import Dodge.Item.Craftable
-- this is not ideal, should fold the itemtype into a stackable/unstackable type
itemFromBase :: ItemBaseType -> Item
itemFromBase ibt = case ibt of
NOTDEFINED -> error "cannot create undefined item"
EFFGUN _ -> undefined
AUTOEFFGUN _ -> undefined
-- Weapons
HELD ht -> itemFromHeldType ht
LEFT lt -> itemFromLeftType lt
EQUIP et -> itemFromEquipType et
--GRENADE
--REMOTEBOMB
-- Utility items
Consumable et -> itemFromConsumableType et
CRAFT cr -> makeTypeCraft cr
KEYCARD i -> keyCard i
itemFromConsumableType :: ConsumableItemType -> Item
itemFromConsumableType ct = case ct of
MEDKIT i -> medkit i
itemFromEquipType :: EquipItemType -> Item
itemFromEquipType et = case et of
@@ -59,6 +52,7 @@ itemFromLeftType lt = case lt of
-- Equipment
itemFromHeldType :: HeldItemType -> Item
itemFromHeldType ht = case ht of
KEYCARD i -> keyCard i
TORCH -> torch
SHATTERGUN -> shatterGun
BANGSTICK i -> bangStick i
@@ -118,17 +112,3 @@ itemFromHeldType ht = case ht of
HELDDETECTOR d -> clickDetector d
FLATSHIELD -> flatShield
baseToFamily :: ItemBaseType -> ItemFamily
baseToFamily ibt = case ibt of
NOTDEFINED -> undefined
EFFGUN _ -> undefined
AUTOEFFGUN _ -> undefined
HELD _ -> HeldFamily
LEFT _ -> LeftClickFamily
EQUIP _ -> EquipmentFamily
CRAFT _ -> CraftingFamily
KEYCARD _ -> HeldFamily
MEDKIT _ -> ConsumableFamily
src/Dodge/Item/Amount.hs
+2 -2
View File
@@ -3,5 +3,5 @@ import Dodge.Data
import Data.Maybe
import Control.Lens
itStackAmount :: Item -> IcAmount
itStackAmount it = fromMaybe 1 $ it ^? itConsumption . icAmount
itStackAmount :: Item -> ItAmount
itStackAmount it = fromMaybe 1 $ it ^? itUse . useAmount
src/Dodge/Item/Attachment.hs
+1 -1
View File
@@ -16,7 +16,7 @@ charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv
. ix (crSel $ _creatures (_cWorld w) IM.! cid) . itAttachment . atCharMode of
. ix (crSel $ _creatures (_cWorld w) IM.! cid) . itUse . heldScroll . hsCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
src/Dodge/Item/Consumable.hs
+2 -6
View File
@@ -14,12 +14,8 @@ import qualified IntMapHelp as IM
medkit :: Int -> Item
medkit i = defaultConsumable
{ _itUse = ConsumeUse
{_cUse = CHeal i
}
, _itID = Nothing
}
& itType . iyBase .~ MEDKIT i
& itUse . cUse .~ CHeal i
& itType . iyBase .~ Consumable (MEDKIT i)
heal25 :: Int -> World -> Maybe World
heal25 = heal 25
src/Dodge/Item/Craftable.hs
+1 -1
View File
@@ -13,7 +13,7 @@ makeTypeCraftNum :: Int -> CraftType -> Item
makeTypeCraftNum i ct = defaultCraftable
& itInvSize .~ 0.5
& itCurseStatus .~ Uncursed
& itConsumption .~ ItemItselfConsumable (IcAmount i)
& itUse . useAmount .~ fromIntegral i
& itType . iyBase .~ CRAFT ct
makeTypeCraft :: CraftType -> Item
src/Dodge/Item/Display.hs
+75 -71
View File
@@ -1,105 +1,109 @@
module Dodge.Item.Display
( itemDisplay
, selectedItemDisplay
, itemString
)
where
import Dodge.Module
import Dodge.Data
import Dodge.Inventory.ItemSpace
import Padding
import LensHelp
module Dodge.Item.Display (
itemDisplay,
selectedItemDisplay,
itemString,
) where
import Data.Maybe
import Data.Sequence
import Dodge.Data
import Dodge.Inventory.ItemSpace
import Dodge.Module
import LensHelp
import Padding
itemDisplay :: Item -> [String]
itemDisplay it = itemDisplayWithNumber (showConsumption (_itUse it)) it
itemDisplayWithNumber :: String -> Item -> [String]
itemDisplayWithNumber numberstr it =
Prelude.take (itSlotsTaken it) $
(midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) :
catMaybes [maybeWarmupStatus it, maybeRateStatus it]
++ moduleStrings it
++ repeat "*"
where
thename = itemBaseName it
theparam =
fromMaybe []
. listToMaybe
$ mapMaybe
($ it)
[ maybeModeStatus
]
itemString :: Item -> String
itemString = head . itemDisplay
itemBaseName :: Item -> String
itemBaseName it = case _iyBase $ _itType it of
itemBaseName it = case _iyBase $ _itType it of
CRAFT str -> show str
HELD hit -> case hit ^? xNum of
Just i -> takeWhile (/=' ') (show hit) ++ show i
HELD hit -> case hit ^? xNum of
Just i -> takeWhile (/= ' ') (show hit) ++ show i
Nothing -> show hit
x -> show x
itemDisplayWithNumber :: String -> Item -> [String]
itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $
(midPadL 15 ' ' thename (' ' : numberstr) ++ theparam)
: catMaybes [maybeWarmupStatus it,maybeRateStatus it]
++ moduleStrings it ++ repeat "*"
where
thename = itemBaseName it
theparam = fromMaybe []
. listToMaybe
$ mapMaybe ($ it)
[ maybeModeStatus
]
LEFT lit -> show lit
EQUIP eit -> show eit
Consumable cit -> show cit
selectedItemDisplay :: Creature -> Item -> [String]
selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itConsumption it)) it
selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itUse it)) it
{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -}
-- TODO make work on remote launchers
itemDisplay :: Item -> [String]
itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it
-- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.
showSelectedConsumption :: Creature -> ItemUse -> String
showSelectedConsumption cr iu = case iu of
RightUse{} -> showReloadProgress cr (_heldConsumption iu)
LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
EquipUse{} -> ""
_ -> show $ iu ^?! useAmount . getItAmount -- partial, be careful if adding new data constructors
showSelectedConsumption :: Creature -> ItemConsumption -> String
showSelectedConsumption cr ic = case ic of
LoadableAmmo{} -> showReloadProgress cr ic
AutoRecharging {} -> showAutoRechargeProgress ic
ChargeableAmmo{} -> show $ _wpCharge ic
ItemItselfConsumable{} -> show (_icAmount ic)
NoConsumption -> ""
showAutoRechargeProgress :: LeftConsumption -> String
showAutoRechargeProgress lc = case lc of
AutoRecharging{}
| _arLoaded lc < _arMax lc -> show (_arProgress lc) ++ "C" ++ show (_arLoaded lc)
| otherwise -> show (_arLoaded lc)
ChargeableAmmo{} -> show (_wpCharge lc)
showAutoRechargeProgress :: ItemConsumption -> String
showAutoRechargeProgress ic
| l < _arMax ic = show (_arProgress ic) ++ "C" ++ show l
| otherwise = show l
where
l = _arLoaded ic
showReloadProgress :: Creature -> ItemConsumption -> String
showReloadProgress :: Creature -> HeldConsumption -> String
showReloadProgress cr ic = case cr ^?! crInvSel . iselAction of
ReloadAction i la _ -> show i ++ showLoadActionType la (_laLoaded ic)
_ -> case ic ^? laProgress . _Just . ix 0 of
Nothing -> show $ _laLoaded ic
Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
showLoadProgress :: Int -> Maybe [LoadAction] -> String
showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
Just la -> show (_actionTime la) ++ showLoadActionType la x
Nothing -> show x
showConsumption :: ItemUse -> String
showConsumption iu = case iu of
RightUse{} -> showReloadProgress' (_heldConsumption iu)
LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
EquipUse{} -> ""
_ -> show $ iu ^?! useAmount . getItAmount
showConsumption :: ItemConsumption -> String
showConsumption ic = case ic of
LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic)
AutoRecharging {} -> showAutoRechargeProgress ic
ChargeableAmmo{} -> show $ _wpCharge ic
ItemItselfConsumable{} -> show (_icAmount ic)
NoConsumption -> ""
showReloadProgress' :: HeldConsumption -> String
showReloadProgress' ic = case ic ^? laProgress . _Just . ix 0 of
Nothing -> show $ _laLoaded ic
Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
showLoadActionType :: LoadAction -> Int -> String
showLoadActionType la x = case la of
LoadEject {} -> "E"
LoadInsert {} -> "L"
LoadAdd {} -> "A" ++ show x
LoadPrime {} -> "P"
LoadEject{} -> "E"
LoadInsert{} -> "L"
LoadAdd{} -> "A" ++ show x
LoadPrime{} -> "P"
maybeWarmupStatus :: Item -> Maybe String
maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
Nothing -> Nothing
Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
x | x <= 1 -> Just "*WARM"
| otherwise -> let n = show x
in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
x
| x <= 1 -> Just "*WARM"
| otherwise ->
let n = show x
in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
maybeModeStatus :: Item -> Maybe String
maybeModeStatus it = case it ^? itAttachment of
Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
Just AttachMode {_atMode = i} -> Just $ show i
_ -> Nothing
maybeModeStatus it = case it ^? itUse . heldScroll of
Just HeldScrollCharMode{_hsCharMode = (c :<| _)} -> Just [' ', c]
Just HeldScrollInt{_hsInt = i} -> Just $ show i
_ -> Nothing
maybeRateStatus :: Item -> Maybe String
maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
src/Dodge/Item/Draw/SPic.hs
+9 -16
View File
@@ -16,15 +16,7 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) <> case it ^. i
HELD ht -> heldItemSPic ht it
LEFT lt -> leftItemSPic lt it
EQUIP et -> equipItemSPic et it
NOTDEFINED -> defSPic
EFFGUN _ -> defSPic
AUTOEFFGUN _ -> defSPic
--
--
KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
--
MEDKIT _ -> defSPic
Consumable {} -> defSPic
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
@@ -100,6 +92,7 @@ heldItemSPic ht it = case ht of
DRONELAUNCHER -> defSPic
SHATTERGUN -> shatterGunSPic
HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
torchShape :: Shape
torchShape = colorSH blue
@@ -132,7 +125,7 @@ baseStickShape :: Shape
baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2
stickClip :: Item -> Shape
stickClip it = case it ^? itConsumption . laLoaded of
stickClip it = case it ^? itUse . heldConsumption . laLoaded of
Just x | x > 0 -> foldMap f [0..x-1]
_ -> mempty
where
@@ -163,7 +156,7 @@ baseRifleShape :: Shape
baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
makeSingleClipAt :: Point3 -> Item -> Shape
makeSingleClipAt p it = case it ^? itConsumption . laLoaded of
makeSingleClipAt p it = case it ^? itUse . heldConsumption . laLoaded of
Just 0 -> mempty
_ -> translateSH p $ upperPrismPoly 1 $ square 1.5
@@ -172,7 +165,7 @@ makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1
$ rectNSWE 0 (-y) (-2) 2
where
y = fromIntegral y' * 0.3
y' = fromMaybe 0 $ it ^? itConsumption . laLoaded
y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laLoaded
volleyGunSPic :: Int -> Item -> SPic
volleyGunSPic i it = noPic $
@@ -183,7 +176,7 @@ volleyGunSPic i it = noPic $
caneClipX :: Int -> Item -> Shape
caneClipX i it = case it ^? itConsumption . laLoaded of
caneClipX i it = case it ^? itUse . heldConsumption . laLoaded of
Just la | la > 0 -> foldMap
( (\y -> translateSH (V3 5 0 3) . upperPrismPoly 1 $ map (+.+ V2 0 y) $ square 1.5)
. (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5)))
@@ -191,9 +184,9 @@ caneClipX i it = case it ^? itConsumption . laLoaded of
_ -> mempty
miniGunXPictItem :: Int -> Item -> SPic
miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _itConsumption it)
miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _heldConsumption (_itUse it))
where
spin = (-10) * _laLoaded (_itConsumption it) + _warmTime (_useDelay $ _itUse it)
spin = (-10) * _laLoaded (_heldConsumption (_itUse it)) + _warmTime (_useDelay $ _itUse it)
miniGunXPict :: Int -> Int -> Int -> SPic
miniGunXPict i spin _ =
@@ -216,7 +209,7 @@ baseSonicShape :: Shape
baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
revolverClip :: Item -> Shape
revolverClip it = case it ^? itConsumption . laLoaded of
revolverClip it = case it ^? itUse . heldConsumption . laLoaded of
Just al | al > 0 -> translateSH (V3 5 0 1) $ foldMap f [1..al]
_ -> mempty
where
src/Dodge/Item/Equipment.hs
+220 -184
View File
@@ -1,109 +1,120 @@
module Dodge.Item.Equipment
( module Dodge.Item.Equipment.Booster
, torch
, magShield
, powerLegs
, flatShield
, wristInvisibility
, wristArmour
, hat
, brainHat
, frontArmour
, headLamp
, headLamp1
, jetPack
, speedLegs
, jumpLegs
, flameShield
module Dodge.Item.Equipment (
module Dodge.Item.Equipment.Booster,
torch,
magShield,
powerLegs,
flatShield,
wristInvisibility,
wristArmour,
hat,
brainHat,
frontArmour,
headLamp,
headLamp1,
jetPack,
speedLegs,
jumpLegs,
flameShield,
useMagShield,
setWristShieldPos,
createHeadLamp,
overCID,
onEquipWristShield,
onRemoveWristShield,
createShieldWall,
removeShieldWall,
) where
, useMagShield
, setWristShieldPos
, createHeadLamp
, overCID
, onEquipWristShield
, onRemoveWristShield
, createShieldWall
, removeShieldWall
) where
import Dodge.Data
import Dodge.Item.Draw
import Dodge.Item.Equipment.Booster
import Dodge.LightSource
import Dodge.Default
import Dodge.Creature.Test
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Default
import Dodge.Item.Equipment.Booster
import Dodge.Item.HeldOffset
import Dodge.LightSource
import Dodge.Wall
import Dodge.Wall.ForceField
import Picture
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Data.Maybe
import Picture
magShield :: Item
magShield = defaultEquipment
{ _itID = Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ EMagShield --useMagShield
& itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD
magShield =
defaultEquipment
{ _itID = Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ EMagShield --useMagShield
& itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where
themagnet = Magnet
{_mgID = mgid
,_mgUpdate = MagnetUpdateTimer 1
,_mgPos = _crPos cr
,_mgField = MagnetBuBuCurveAroundField 50 200
}
themagnet =
Magnet
{ _mgID = mgid
, _mgUpdate = MagnetUpdateTimer 1
, _mgPos = _crPos cr
, _mgField = MagnetBuBuCurveAroundField 50 200
}
mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets (_cWorld w)
-- it = _crInv cr IM.! invid
flameShield :: Item
flameShield = defaultEquipment
{ _itID = Nothing
} & itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FLAMESHIELD
{- | Slows you down, blocks forward projectiles. -}
flameShield :: Item
flameShield =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FLAMESHIELD
-- | Slows you down, blocks forward projectiles.
frontArmour :: Item
frontArmour = defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FRONTARMOUR
frontArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FRONTARMOUR
wristArmour :: Item
wristArmour = defaultEquipment
{_itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
& itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
& itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
& itType . iyBase .~ EQUIP WRISTARMOUR
wristArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
& itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
& itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
& itType . iyBase .~ EQUIP WRISTARMOUR
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& cWorld . walls . at i ?~ forceField {_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
onEquipWristShield itm cr w =
w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& cWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
where
i = IM.newKey (_walls (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w = w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i
onRemoveWristShield itm cr w =
w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w
& moveWallIDUnsafe i wlline
setWristShieldPos itm cr w =
w
& moveWallIDUnsafe i wlline
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
@@ -112,160 +123,185 @@ setWristShieldPos itm cr w = w
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
g | twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
torch :: Item
torch = defaultWeapon
& itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect-- createHeldLight (const $ const id)
& itType . iyBase .~ HELD TORCH
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 10
torch =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
& itType . iyBase .~ HELD TORCH
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 10
flatShield :: Item
flatShield = defaultWeapon
& itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall --createShieldWall removeShieldWall
-- the above seems to work, but I am not sure why: it may break on edge
-- cases
& itUse .~ defaultrUse
{ _rUse = HeldDoNothing
, _useDelay = NoDelay
, _useMods = HeldModNothing
, _useHammer = HammerUp
, _useAim = AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
flatShield =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
& itUse
.~ defaultrUse
{ _useAim =
AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
shieldWall :: Int -> Wall
shieldWall crid = defaultWall
{_wlColor = yellow
,_wlOpacity = SeeAbove
,_wlPathable = True
,_wlWalkable = True
,_wlFireThrough = True
,_wlReflect = True
,_wlUnshadowed = False
,_wlRotateTo = False
,_wlStructure = CreaturePart crid -- shieldWallDamage
}
shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = True
, _wlReflect = True
, _wlUnshadowed = False
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
}
-- TODO the reflection should be controled by the particle
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
---- Lasering -> w
---- Lasering -> w
-- _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
-- _ -> w
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
Nothing ->
let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
Just wid -> moveWallID wid wlline w
where
invid = fromJust $ _itID it
crid = _crID cr
wlline = (a,b)
wlline = (a, b)
crdirv = unitVectorAtAngle $ _crDir cr
crpos = _crPos cr
rad = _crRad cr + 2
a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
therot | crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
therot
| crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> w
Just wid -> w & deleteWallID wid
& cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
Just wid ->
w & deleteWallID wid
& cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
where
crid = _crID cr
invid = fromJust (_itID it)
effectOnOffHeld
:: ItInvEffect -- ^ effect when held
-> ItInvEffect -- ^ effect when not held
-> ItEffect
effectOnOffHeld f f' = ItInvEffectID
{ _ieInv = OnOffHeldEffect f f'
, _ieMID = Nothing
}
effectOnOffHeld ::
-- | effect when held
ItInvEffect ->
-- | effect when not held
ItInvEffect ->
ItEffect
effectOnOffHeld f f' =
ItInvEffectID
{ _ieInv = OnOffHeldEffect f f'
, _ieMID = Nothing
}
{- | Increases speed, reduces friction, cannot only move forwards. -}
-- | Increases speed, reduces friction, cannot only move forwards.
jetPack :: Item
jetPack = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
} & itUse . eqEq . eqSite .~ GoesOnBack
& itType . iyBase .~ EQUIP JETPACK
jetPack =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnBack
& itType . iyBase .~ EQUIP JETPACK
brainHat :: Item
brainHat = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP BRAINHAT
brainHat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP BRAINHAT
hat :: Item
hat = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HAT
hat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HAT
headLamp1 :: Item
headLamp1 = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP1
headLamp :: Item
headLamp = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP
headLamp1 =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP1
headLamp :: Item
headLamp =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
createHeadLamp _ cr =
cWorld . tempLightSources
.:~ tlsTimeRadColPos
1
200
0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
powerLegs = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnLegs
& itType . iyBase .~ EQUIP POWERLEGS
powerLegs =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnLegs
& itType . iyBase .~ EQUIP POWERLEGS
speedLegs :: Item
speedLegs = powerLegs
& itType . iyBase .~ EQUIP SPEEDLEGS
speedLegs =
powerLegs
& itType . iyBase .~ EQUIP SPEEDLEGS
jumpLegs :: Item
jumpLegs = powerLegs
& itType . iyBase .~ EQUIP JUMPLEGS
jumpLegs =
powerLegs
& itType . iyBase .~ EQUIP JUMPLEGS
wristInvisibility :: Item
wristInvisibility = defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
& itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
wristInvisibility =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
& itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
src/Dodge/Item/Equipment/Booster.hs
+14 -78
View File
@@ -1,84 +1,20 @@
module Dodge.Item.Equipment.Booster
( boosterGun
, boostSelfL
) where
import Dodge.Data
import Dodge.Base
module Dodge.Item.Equipment.Booster (
boosterGun,
) where
import Control.Lens
import Dodge.Data.Item
import Dodge.Default.Weapon
import Geometry
import qualified IntMapHelp as IM
import Picture
import Data.Maybe
import Control.Lens
{- | Move a creature towards the mouse position, with shockwave -}
boostPoint
:: Float -- ^ boost amount
-> Creature
-> World
-> Either Point2 Point2
boostPoint x cr w = case mayp2 of
Nothing -> Right p1
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
boostSelfL
:: Float -- ^ boost amount
-> Item
-> Creature
-> World
-> World
boostSelfL x itm cr w = case boostPoint x cr w of
Left p -> crEff p (itConsumption . laLoaded .~ 0)
Right p -> crEff p (itConsumption . laLoaded -~ 1)
where
invid = _ipInvID $ _itPos itm
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (IM.newKey $ _props (_cWorld w))
(cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& cWorld . creatures . ix cid %~
(crPos .~ p)
. (crInv . ix invid %~
ammoEff
. (itEffect . ieCounter .~ 1)
. (itAttachment .~ AttachInt pid)
)
addBoostShockwave
:: Int
-> Point2
-> Point2
-> World
-> World
addBoostShockwave pjid p v w = w & cWorld . linearShockwaves %~
IM.insertWith f pjid thePJ
where
thePJ = LinearShockwave
{ _lwPos = p
, _lwID = pjid
, _lwPoints = [(p,v)]
, _lwTimer = maxT
}
f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
maxT :: Int
maxT = 20
boosterGun :: Item
boosterGun = defaultLeftItem
{ _itInvColor = cyan
, _itConsumption = defaultChargeable
, _itUse = luseInstantNoH LBoost
, _itEffect = resetAttachmentID
}
& itType . iyBase .~ LEFT BOOSTER
boosterGun =
defaultLeftItem
{ _itInvColor = cyan
, _itUse = luseInstantNoH LBoost
, _itEffect = resetAttachmentID
}
& itType . iyBase .~ LEFT BOOSTER
resetAttachmentID :: ItEffect
resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
src/Dodge/Item/Location.hs
+4 -4
View File
@@ -30,8 +30,8 @@ getItem itid w = do
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
VoidItm -> Nothing
pointToItem :: Applicative f =>
pointerToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointToItem _ = const pure
pointerToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointerToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointerToItem _ = const pure
src/Dodge/Item/PassKey.hs
+1 -1
View File
@@ -10,7 +10,7 @@ keyCard n = defaultEquipment
-- , _itZoom = defaultItZoom
, _itInvColor = aquamarine
}
& itType . iyBase .~ KEYCARD n
& itType . iyBase .~ HELD (KEYCARD n)
latchkey :: Int -> Item
latchkey _ = defaultEquipment
src/Dodge/Item/Weapon/BatteryGuns.hs
+5 -7
View File
@@ -55,8 +55,8 @@ sparkGun = teslaGun
& itParams . arcSize .~ 10
teslaGun :: Item
teslaGun = defaultBatteryGun
& itConsumption . laMax .~ 200
& itConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
& itUse . heldConsumption . laMax .~ 200
& itUse . heldConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
& itDimension . dimRad .~ 9
& itDimension . dimCenter .~ V3 4 0 0
& itParams .~ teslaParams
@@ -91,7 +91,7 @@ lasCircle = lasGun
& itType . iyBase .~ HELD LASCIRCLE
& itParams . lasColor .~ orange
& itParams . lasDamage .~ 2
& itConsumption . laMax .~ 10000
& itUse . heldConsumption . laMax .~ 10000
& itUse . rUse .~ HeldLaser --shootLaser
& itUse . useDelay .~ NoDelay
& itUse . rUse .~ HeldCircleLaser --circleLaser
@@ -212,7 +212,7 @@ dualBeam = lasGun
-- x' = _lasCycle $ _itParams it
lasGun :: Item
lasGun = defaultAutoBatteryGun
& itConsumption .~ ( defaultLoadable
& itUse . heldConsumption .~ ( defaultLoadable
& laMax .~ 200
& laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
)
@@ -225,7 +225,6 @@ lasGun = defaultAutoBatteryGun
}
& itTweaks .~ Tweakable
{ _tweakParams = IM.fromList [(0,lasGunTweak)]
, _tweakSel = 0
}
& itDimension . dimRad .~ 10
& itDimension . dimCenter .~ V3 15 0 0
@@ -247,14 +246,13 @@ lasGunTweak = TweakParam
}
tractorGun :: Item
tractorGun = lasGun
& itConsumption .~
& itUse . heldConsumption .~
( defaultLoadable
& laMax .~ 10000
& laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60] )
& itParams .~ Attracting {_attractionPower = 1}
& itTweaks .~ Tweakable
{ _tweakParams = IM.fromList [(0,tractorGunTweak)]
, _tweakSel = 0
}
& itUse . rUse .~ HeldTractor --aTractorBeam
& itUse . useDelay .~ NoDelay
src/Dodge/Item/Weapon/Bullet.hs
+1 -1
View File
@@ -13,7 +13,7 @@ basicBullet = BulletAmmo
}
defaultBullet :: Bullet
defaultBullet = Bullet
{ _buState = NormalBulletState
{ _buDelayFraction = 1
, _buEffect = DestroyBullet
, _buSpawn = BulSpark
, _buUpdateMod = NoBulletUpdateMod
src/Dodge/Item/Weapon/BulletGun/Cane.hs
+15 -16
View File
@@ -37,8 +37,8 @@ defaultBangCane =
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 15
& itType . iyBase .~ error "undefined bangCane baseitemtype"
& itConsumption . laMax .~ 1
& itConsumption . laCycle .~ [loadPartialInsert 10 1]
& itUse . heldConsumption . laMax .~ 1
& itUse . heldConsumption . laCycle .~ [loadPartialInsert 10 1]
volleyGun :: Int -> Item
volleyGun i =
@@ -51,7 +51,7 @@ volleyGun i =
& itUse . useAim . aimZoom .~ defaultItZoom{_itZoomFac = 1.5}
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 15
& itConsumption . laMax .~ i
& itUse . heldConsumption . laMax .~ i
& itParams
.~ BulletShooter
{ _muzVel = 0.8
@@ -79,8 +79,8 @@ rifle =
defaultBangCane
& itUse . useAim . aimStance .~ TwoHandTwist
& itType . iyBase .~ HELD RIFLE
& itConsumption . laMax .~ 1
& itConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
& itUse . heldConsumption . laMax .~ 1
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
& itUse . useAim . aimWeight .~ 6
& itUse . useAim . aimRange .~ 1
& itUse . useAim . aimZoom .~ defaultItZoom{_itZoomFac = 2}
@@ -91,8 +91,8 @@ repeater =
rifle
& itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
& itType . iyBase .~ HELD REPEATER
& itConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
& itConsumption . laMax .~ 15
& itUse . heldConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
& itUse . heldConsumption . laMax .~ 15
autoRifle :: Item
autoRifle =
@@ -120,21 +120,20 @@ miniGunUse i =
miniGunX :: Int -> Item
miniGunX i =
defaultAutoGun
{ _itConsumption =
defaultBulletLoadable
{ _laMax = 1500
, _laLoaded = 1500
}
& laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
, _itUse =
{ _itUse =
miniGunUse i
& useDelay .~ WarmUpNoDelay{_warmTime = 0, _warmMax = 100}
& useAim . aimWeight .~ 6
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
& useAim . aimZoom .~ defaultItZoom{_itZoomFac = 1.5}
, -- , _itFloorPict = miniGunPictItem
_itParams =
& heldConsumption
.~ defaultBulletLoadable
{ _laMax = 1500
, _laLoaded = 1500
}
& heldConsumption . laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
, _itParams =
BulletShooter
{ _muzVel = 1
, _rifling = 0.9
src/Dodge/Item/Weapon/BulletGun/Rod.hs
+6 -6
View File
@@ -30,8 +30,8 @@ bangRod = defaultBulletWeapon
& itUse . useMods .~ BangRodMod
& itDimension . dimRad .~ 12
& itDimension . dimCenter .~ V3 5 0 0
& itConsumption . laMax .~ 1
& itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
& itUse . heldConsumption . laMax .~ 1
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
& itType . iyBase .~ HELD BANGROD
& itUse . useAim . aimWeight .~ 8
& itUse . useAim . aimRange .~ 1
@@ -39,7 +39,7 @@ bangRod = defaultBulletWeapon
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 30
& itConsumption . laAmmoType .~ hvBullet
& itUse . heldConsumption . laAmmoType .~ hvBullet
elephantGun :: Item
elephantGun = bangRod
& itType . iyBase .~ HELD ELEPHANTGUN
@@ -51,7 +51,7 @@ elephantGun = bangRod
amr :: Item
amr = elephantGun
& itType . iyBase .~ HELD AMR
& itConsumption . laMax .~ 15
& itUse . heldConsumption . laMax .~ 15
autoAmr :: Item
autoAmr = amr
@@ -77,7 +77,7 @@ machineGun = bangRod
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
& itUse . useDelay .~ VariableRate {_rateMax = 25, _rateMaxMax = 24, _rateMinMax = 7, _rateTime = 0}
& itConsumption . laMax .~ 100
& itConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
& itUse . heldConsumption . laMax .~ 100
& itUse . heldConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
& itInvSize .~ 3
& itParams. torqueAfter .~ 0.2 -- not sure if this is necessary?
src/Dodge/Item/Weapon/BulletGun/Stick.hs
+5 -5
View File
@@ -36,15 +36,15 @@ bangStick i = defaultBulletWeapon
& itType . iyBase .~ HELD (BANGSTICK i)
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 10
& itConsumption . laMax .~ i
& itConsumption . laCycle .~ [loadPartialInsert 10 1]
& itUse . heldConsumption . laMax .~ i
& itUse . heldConsumption . laCycle .~ [loadPartialInsert 10 1]
baseStickSpread :: Float
baseStickSpread = 0.2
revolver :: Item
revolver = pistol
& itConsumption .~
& itUse . heldConsumption .~
(defaultBulletLoadable
& laMax .~ 6
& laCycle .~ [loadPartialInsert 10 1] )
@@ -52,7 +52,7 @@ revolver = pistol
pistol :: Item
pistol = bangStick 1
& itConsumption .~ ( defaultBulletLoadable
& itUse . heldConsumption .~ ( defaultBulletLoadable
& laMax .~ 15
& laCycle .~ [loadEject 5, loadInsert 5 , loadPrime 5] )
& itUse . useDelay . rateMax .~ 6
@@ -89,5 +89,5 @@ revolverX :: Int -> Item
revolverX i = revolver
& itUse . useDelay . rateMax .~ 8
& itUse . useMods .~ RevolverXMod
& itConsumption . laMax .~ i * 6
& itUse . heldConsumption . laMax .~ i * 6
& itType . iyBase .~ HELD (REVOLVERX i)
src/Dodge/Item/Weapon/BulletGuns.hs
+6 -6
View File
@@ -82,13 +82,13 @@ bangCone = defaultBulletWeapon
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 15
& itType . iyBase .~ HELD BANGCONE
& itConsumption . laMax .~ 5
& itConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
& itUse . heldConsumption . laMax .~ 5
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
blunderbuss :: Item
blunderbuss = bangCone
& itConsumption . laMax .~ 25
& itConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
& itUse . heldConsumption . laMax .~ 25
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimWeight .~ 6
& itUse . useAim . aimHandlePos .~ 5
@@ -97,8 +97,8 @@ blunderbuss = bangCone
grapeCannon :: Int -> Item
grapeCannon i = blunderbuss
& itType . iyBase .~ HELD (GRAPECANNON i)
& itConsumption . laMax .~ 25 + 25 * i
& itConsumption . laCycle .~ [loadEject 5, loadInsert (30 + i * 10) , loadPrime 5]
& itUse . heldConsumption . laMax .~ 25 + 25 * i
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert (30 + i * 10) , loadPrime 5]
& itParams . recoil .~ (150 + fromIntegral i * 50)
& itParams . torqueAfter .~ (0.1 + 0.2 * fromIntegral i)
& itParams . randomOffset .~ (12 + 4 * fromIntegral i)
src/Dodge/Item/Weapon/Drone.hs
+2 -2
View File
@@ -16,8 +16,8 @@ droneLauncher = defaultWeapon
& itUse . useAim . aimWeight .~ 8
& itUse . useAim . aimRange .~ 0.5
& itUse . useAim . aimStance .~ TwoHandTwist
& itConsumption . laAmmoType .~ DroneAmmo { _amString = "LASDRONE" }
& itConsumption . laMax .~ 2
& itUse . heldConsumption . laAmmoType .~ DroneAmmo { _amString = "LASDRONE" }
& itUse . heldConsumption . laMax .~ 2
& itType . iyBase .~ HELD DRONELAUNCHER
lasDronesPic :: Item -> SPic
src/Dodge/Item/Weapon/FractionLoaded.hs
+3 -3
View File
@@ -6,17 +6,17 @@ import Dodge.Data
---- this shouldn't really be used
loadedAmmo :: Item -> Int
loadedAmmo = _laLoaded . _itConsumption
loadedAmmo = _laLoaded . _heldConsumption . _itUse
-- | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it)
-- | otherwise = 0
fractionLoadedAmmo :: Item -> Float
fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it)
where
itmaxammo = _laMax . _itConsumption
itmaxammo = _laMax . _heldConsumption . _itUse
fractionLoadedAmmo2 :: Item -> Float
fractionLoadedAmmo2 it = 1 -
(1 - fromIntegral (loadedAmmo it) / fromIntegral (itMaxAmmo it))**2
where
itMaxAmmo = _laMax . _itConsumption
itMaxAmmo = _laMax . _heldConsumption . _itUse
src/Dodge/Item/Weapon/Launcher.hs
+102 -90
View File
@@ -1,110 +1,122 @@
module Dodge.Item.Weapon.Launcher
( launcher
, launcherX
, remoteLauncher
, fireTrackingShell
, explodeRemoteRocket
) where
module Dodge.Item.Weapon.Launcher (
launcher,
launcherX,
remoteLauncher,
fireTrackingShell,
explodeRemoteRocket,
) where
import Control.Lens
import Dodge.Data
import Dodge.Projectile.Create
import Dodge.Payload
import Dodge.Reloading.Action
import Dodge.Default.Weapon
import Dodge.Item.Location
import Dodge.Payload
import Dodge.Projectile.Create
import Dodge.Reloading.Action
import Geometry
import qualified IntMapHelp as IM
import Control.Lens
launcher :: Item
launcher = defaultWeapon
{ _itConsumption = defaultLoadable
& laAmmoType .~ ProjectileAmmo
{ _amPayload = ExplosionPayload
, _amString = "EXPLOSIVE SHELL"
, _amPjDraw = DrawShell
, _amPjCreation = CreateShell
}
& laMax .~ 1
& laLoaded .~ 1
& laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
, _itParams = ShellLauncher
{ _shellSpinDrag = 1
, _shellSpinAmount = 2
, _shellThrustDelay = 20
launcher =
defaultWeapon
{ _itParams =
ShellLauncher
{ _shellSpinDrag = 1
, _shellSpinAmount = 2
, _shellThrustDelay = 20
}
, _itTweaks =
Tweakable
{ _tweakParams = basicAmPjMoves
}
, _itInvSize = 3
}
, _itTweaks = Tweakable
{ _tweakSel = 0
, _tweakParams = basicAmPjMoves
}
, _itInvSize = 3
}
& itDimension . dimRad .~ 9
& itDimension . dimCenter .~ V3 10 0 0
& itUse . useDelay . rateMax .~ 20
& itUse . rUse .~ HeldPJCreation --usePjCreation
& itUse . useMods .~ LauncherMod
& itUse . useAim . aimWeight .~ 8
& itUse . useAim . aimRange .~ 0.5
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 20
& itType . iyBase .~ HELD LAUNCHER
& itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
& itDimension . dimRad .~ 9
& itDimension . dimCenter .~ V3 10 0 0
& itUse . useDelay . rateMax .~ 20
& itUse . rUse .~ HeldPJCreation --usePjCreation
& itUse . useMods .~ LauncherMod
& itUse . useAim . aimWeight .~ 8
& itUse . useAim . aimRange .~ 0.5
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 20
& itUse . heldConsumption . laAmmoType .~ ProjectileAmmo
{ _amPayload = ExplosionPayload
, _amString = "EXPLOSIVE SHELL"
, _amPjDraw = DrawShell
, _amPjCreation = CreateShell
}
& itUse . heldConsumption . laMax .~ 1
& itUse . heldConsumption . laLoaded .~ 1
& itUse . heldConsumption . laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
& itType . iyBase .~ HELD LAUNCHER
& itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
launcherX :: Int -> Item
launcherX i = launcher
& itType . iyBase .~ HELD (LAUNCHERX i)
& itConsumption . laMax .~ i
& itConsumption . laLoaded .~ i
& itUse . rUse .~ HeldPJCreationX i
& itUse . useMods .~ LauncherXMod i
launcherX i =
launcher
& itType . iyBase .~ HELD (LAUNCHERX i)
& itUse . heldConsumption . laMax .~ i
& itUse . heldConsumption . laLoaded .~ i
& itUse . rUse .~ HeldPJCreationX i
& itUse . useMods .~ LauncherXMod i
basicAmPjMoves :: IM.IntMap TweakParam
basicAmPjMoves = IM.fromList . zip [0..] $
[spinDrag
,spinStart
,thrustParam
]
basicAmPjMoves =
IM.fromList . zip [0 ..] $
[ spinDrag
, spinStart
, thrustParam
]
spinDrag :: TweakParam
spinDrag = TweakParam
{ _tweakType = TweakSpinDrag
, _tweakVal = 1
, _tweakMax = 5
}
spinDrag =
TweakParam
{ _tweakType = TweakSpinDrag
, _tweakVal = 1
, _tweakMax = 5
}
spinStart :: TweakParam
spinStart = TweakParam
{ _tweakType = TweakSpinAmount
, _tweakVal = 2
, _tweakMax = 5
}
spinStart =
TweakParam
{ _tweakType = TweakSpinAmount
, _tweakVal = 2
, _tweakMax = 5
}
thrustParam :: TweakParam
thrustParam = TweakParam
{ _tweakType = TweakThrustDelay
, _tweakVal = 1
, _tweakMax = 5
}
thrustParam =
TweakParam
{ _tweakType = TweakThrustDelay
, _tweakVal = 1
, _tweakMax = 5
}
remoteLauncher :: Item
remoteLauncher = launcher
& itType . iyBase .~ HELD REMOTELAUNCHER
& itUse . rUse .~ HeldFireRemoteShell --fireRemoteShell
& itScope .~ RemoteScope (V2 0 0) 1 True
& itConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
remoteLauncher =
launcher
& itType . iyBase .~ HELD REMOTELAUNCHER
& itUse . rUse .~ HeldFireRemoteShell --fireRemoteShell
& itScope .~ RemoteScope (V2 0 0) 1 True
& itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
-- TODO consider allowing tweaking rocket speed
explodeRemoteRocket
:: Int -- ^ Item id
-> Int -- ^ Projectile id
-> World
-> World
explodeRemoteRocket itid pjid w = w
& cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj)
where
itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
explodeRemoteRocket ::
-- | Item id
Int ->
-- | Projectile id
Int ->
World ->
World
explodeRemoteRocket itid pjid w =
w
& cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj)
where
itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
thepj = _projectiles (_cWorld w) IM.! pjid
src/Dodge/Item/Weapon/Remote.hs
+1 -1
View File
@@ -1,5 +1,5 @@
module Dodge.Item.Weapon.Remote
( pointToItem
( pointerToItem
, setRemoteScope
, setRemoteBombScope
) where
src/Dodge/Item/Weapon/SprayGuns.hs
+90 -78
View File
@@ -1,95 +1,107 @@
module Dodge.Item.Weapon.SprayGuns
( poisonSprayer
, flameSpitter
, blowTorch
, flameThrower
, flameTorrent
, flameWall
) where
module Dodge.Item.Weapon.SprayGuns (
poisonSprayer,
flameSpitter,
blowTorch,
flameThrower,
flameTorrent,
flameWall,
) where
import Dodge.Data
import Dodge.Reloading.Action
import Dodge.Default
import Dodge.Reloading.Action
import Geometry
import LensHelp
poisonSprayer :: Item
poisonSprayer = flameThrower
& itType . iyBase .~ HELD POISONSPRAYER
& itConsumption . laAmmoType .~ GasAmmo
{ _amString = "POISONGAS"
, _amCreateGas = CreatePoisonGas --aGasCloud
}
& itUse . useMods .~ PoisonSprayerMod
poisonSprayer =
flameThrower
& itType . iyBase .~ HELD POISONSPRAYER
& itUse . heldConsumption . laAmmoType
.~ GasAmmo
{ _amString = "POISONGAS"
, _amCreateGas = CreatePoisonGas --aGasCloud
}
& itUse . useMods .~ PoisonSprayerMod
flameSpitter :: Item
flameSpitter = flameThrower
& itType . iyBase .~ HELD FLAMESPITTER
& itConsumption . laMax .~ 10
& itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
& itParams . sprayNozzles . ix 0 . nzPressure .~ 4
& itUse . useAim . aimStance .~ OneHand
& itUse . useDelay .~ FixedRate {_rateMax =12,_rateTime = 0}
& itUse . useMods .~ FlameSpitterMod
flameSpitter =
flameThrower
& itType . iyBase .~ HELD FLAMESPITTER
& itUse . heldConsumption . laMax .~ 10
& itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 10, loadPrime 20]
& itParams . sprayNozzles . ix 0 . nzPressure .~ 4
& itUse . useAim . aimStance .~ OneHand
& itUse . useDelay .~ FixedRate{_rateMax = 12, _rateTime = 0}
& itUse . useMods .~ FlameSpitterMod
flameTorrent :: Item
flameTorrent = flameThrower
& itType . iyBase .~ HELD FLAMETORRENT
& itUse . useAim . aimZoom .~ defaultItZoom
& itParams . sprayNozzles . ix 0 %~
( (nzPressure .~ 10)
. (nzMaxWalkAngle .~ 1.5)
. (nzWalkSpeed .~ 0.05)
)
flameTorrent =
flameThrower
& itType . iyBase .~ HELD FLAMETORRENT
& itUse . useAim . aimZoom .~ defaultItZoom
& itParams . sprayNozzles . ix 0
%~ ( (nzPressure .~ 10)
. (nzMaxWalkAngle .~ 1.5)
. (nzWalkSpeed .~ 0.05)
)
blowTorch :: Item
blowTorch = flameThrower
& itType . iyBase .~ HELD BLOWTORCH
blowTorch =
flameThrower
& itType . iyBase .~ HELD BLOWTORCH
flameWall :: Item
flameWall = flameThrower
& itType . iyBase .~ HELD FLAMEWALL
& itParams . sprayNozzles .~ zipWith makeNozzle [0,0.6,-0.6] [2,2.5,2.5]
flameWall =
flameThrower
& itType . iyBase .~ HELD FLAMEWALL
& itParams . sprayNozzles .~ zipWith makeNozzle [0, 0.6, -0.6] [2, 2.5, 2.5]
where
makeNozzle dir pres = Nozzle
{ _nzPressure = pres
, _nzDir = dir
, _nzMaxWalkAngle = 0
, _nzWalkSpeed = 0
, _nzCurrentWalkAngle = 0
, _nzLength = 20
}
makeNozzle dir pres =
Nozzle
{ _nzPressure = pres
, _nzDir = dir
, _nzMaxWalkAngle = 0
, _nzWalkSpeed = 0
, _nzCurrentWalkAngle = 0
, _nzLength = 20
}
flameThrower :: Item
flameThrower = defaultAutoGun
{ _itConsumption = defaultLoadable
& laMax .~ 250
& laAmmoType .~ GasAmmo
{_amString = "FLAME"
,_amCreateGas = CreateFlame --aFlame
}
& laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
, _itParams = Sprayer
{ _sprayNozzles =
[ Nozzle
{ _nzPressure = 4
, _nzDir = 0
, _nzMaxWalkAngle = 0.2
, _nzWalkSpeed = 0.01
, _nzCurrentWalkAngle = 0
, _nzLength = 10
flameThrower =
defaultAutoGun
{ _itParams =
Sprayer
{ _sprayNozzles =
[ Nozzle
{ _nzPressure = 4
, _nzDir = 0
, _nzMaxWalkAngle = 0.2
, _nzWalkSpeed = 0.01
, _nzCurrentWalkAngle = 0
, _nzLength = 10
}
]
}
]
}
}
& itDimension . dimRad .~ 7
& itDimension . dimCenter .~ V3 9 0 0
& itUse . rUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
& itUse . useDelay .~ NoDelay
& itUse . useMods .~ FlameThrowerMod
& itUse . useAim . aimWeight .~ 5
& itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimHandlePos .~ 0
& itUse . useAim . aimMuzPos .~ 18
& itType . iyBase .~ HELD FLAMETHROWER
& itDimension . dimRad .~ 7
& itDimension . dimCenter .~ V3 9 0 0
& itUse . rUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
& itUse . useDelay .~ NoDelay
& itUse . useMods .~ FlameThrowerMod
& itUse . useAim . aimWeight .~ 5
& itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = 5, _itZoomMin = 1.5}
& itUse . useAim . aimStance .~ TwoHandTwist
& itUse . useAim . aimHandlePos .~ 0
& itUse . useAim . aimMuzPos .~ 18
& itUse . heldConsumption
.~ ( defaultLoadable
& laMax .~ 250
& laAmmoType
.~ GasAmmo
{ _amString = "FLAME"
, _amCreateGas = CreateFlame --aFlame
}
& laCycle .~ [loadEject 5, loadInsert 10, loadPrime 20]
)
& itType . iyBase .~ HELD FLAMETHROWER
src/Dodge/Item/Weapon/TriggerType.hs
+13 -13
View File
@@ -141,7 +141,7 @@ ammoCheckI eff itm cr w
| _laLoaded ic <= 0 || not (_laPrimed ic) = w
| otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
where
ic = _itConsumption itm
ic = _heldConsumption $ _itUse itm
-- combined ammo and hammer check: want to be able to auto-reload even if the
-- hammer is down?
@@ -152,13 +152,13 @@ ammoHammerCheck eff it cr w
Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
_ -> w
where
ic = _itConsumption it
ic = _heldConsumption $ _itUse it
itUseCharge :: Int -> Item -> Item
itUseCharge x = itConsumption . arLoaded %~ (max 0 . subtract x)
itUseCharge x = itUse . leftConsumption . arLoaded %~ (max 0 . subtract x)
itUseAmmo :: Int -> Item -> Item
itUseAmmo x = itConsumption . laLoaded %~ (max 0 . subtract x)
itUseAmmo x = itUse . heldConsumption . laLoaded %~ (max 0 . subtract x)
{- | Fires at an increasing rate.
Has different effect after first fire.
@@ -295,14 +295,14 @@ withSidePushAfterI maxSide eff item cr w = over (cWorld . creatures . ix cid) pu
(pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
useAllAmmo :: ChainEffect
useAllAmmo eff item cr = eff item cr
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr = eff item cr
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded
%~ (max 0 . subtract amAmount))
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = eff item cr
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
{- |
Applies a world effect after an item use cooldown check. -}
useTimeCheck :: ChainEffect
@@ -316,7 +316,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
{- | Applies a world effect after a hammer position check. -}
hammerCheckI :: ChainEffect
hammerCheckI f it cr w = case it ^? itUse . useHammer of
Just HammerUp | _laPrimed (_itConsumption it)
Just HammerUp | _laPrimed (_heldConsumption (_itUse it))
-> f it cr w
_ -> w
@@ -335,7 +335,7 @@ ammoUseCheck f item cr w
pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
fireCondition = crWeaponReady cr
&& _rateTime (_useDelay (_itUse item)) == 0
&& _laLoaded (_itConsumption item) > 0
&& _laLoaded (_heldConsumption (_itUse item)) > 0
-- reloadCondition = _laLoaded (_itConsumption item) == 0
{- | Applies a world effect after a hammer position check.
Arbitrary inventory position. -}
@@ -366,7 +366,7 @@ shootL f item cr w
invid = _ipInvID $ _itPos item
pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
fireCondition = _rateTime (_useDelay (_itUse item)) == 0
&& _arLoaded (_itConsumption item) > 0
&& _arLoaded (_leftConsumption (_itUse item)) > 0
-- reloadCondition = _laLoaded (_itConsumption item) == 0
withItem :: (Item -> ChainEffect) -> ChainEffect
withItem g f it = g it f it
@@ -541,7 +541,7 @@ spreadLoaded eff item cr w = foldr f w dirs
dirs = subtract cd . (spread *) . fromIntegral <$> [0 .. numBulLoaded - 1]
f dir = eff item (cr & crDir +~ dir)
spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
numBulLoaded = _laLoaded $ _itConsumption item
numBulLoaded = _laLoaded $ _heldConsumption (_itUse item)
sideEffectOnFrame :: Int
-> (Item -> Creature -> WdWd)
@@ -571,7 +571,7 @@ duplicateLoaded :: ChainEffect
duplicateLoaded eff it cr w = foldr f w [1..numBul]
where
f _ = eff it cr
numBul = _laLoaded $ _itConsumption it
numBul = _laLoaded $ _heldConsumption (_itUse it)
duplicateLoadedBarrels :: ChainEffect
duplicateLoadedBarrels eff item cr w = foldr f w poss
@@ -582,7 +582,7 @@ duplicateLoadedBarrels eff item cr w = foldr f w poss
poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1]
f pos = eff item (cr & crPos %~ (+.+ pos))
numBar = _brlNum . _gunBarrels $ _itParams item
numBul = _laLoaded $ _itConsumption item
numBul = _laLoaded $ _heldConsumption (_itUse item)
duplicateOffsetsFocus :: [Float] -> ChainEffect
duplicateOffsetsFocus xs eff item cr w = foldr f w poss
src/Dodge/Item/Weapon/Utility.hs
+59 -50
View File
@@ -1,60 +1,67 @@
module Dodge.Item.Weapon.Utility where
import Dodge.Data
import Control.Lens
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Data
import Dodge.Default
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Wall.ForceField
import Dodge.Wall.Move
import Geometry
import Picture
import qualified IntMapHelp as IM
import Picture
import Shape
import ShapePicture
import Data.Maybe
import Control.Lens
rewindGun :: Item
rewindGun = defaultLeftItem
{ _itInvColor = cyan
, _itConsumption = ChargeableAmmo
{ _wpMaxCharge = 250
, _wpCharge = 0
rewindGun =
defaultLeftItem
{ _itInvColor = cyan
, _itEffect = ItRewindEffect RewindEffect -- []
, _itUse =
defaultlUse
& lUse .~ LRewind --useRewindGun
& eqEq . eqSite .~ GoesOnChest
}
, _itEffect = ItRewindEffect RewindEffect-- []
, _itUse = defaultlUse
& lUse .~ LRewind --useRewindGun
& eqEq . eqSite .~ GoesOnChest
}
& itType . iyBase .~ LEFT REWINDER
& itType . iyBase .~ LEFT REWINDER
& itUse . leftConsumption
.~ ChargeableAmmo
{ _wpMaxCharge = 250
, _wpCharge = 0
}
-- needs to shift this item to the current inventory slot
shrinkGun :: Item
shrinkGun = defaultLeftItem
{_itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
-- , _itFloorPict = shrinkGunPic
, _itAttachment = AttachBool True
}
& itType . iyBase .~ LEFT SHRINKER
shrinkGun =
defaultLeftItem
{ _itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
-- , _itFloorPict = shrinkGunPic
, _itAttachment = AttachBool True
}
& itType . iyBase .~ LEFT SHRINKER
shrinkGunPic :: Item -> SPic
shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5
blinkGun :: Item
blinkGun = defaultLeftItem
{ _itInvColor = cyan
, _itUse = defaultlUse
& lUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
& eqEq . eqSite .~ GoesOnWrist
-- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
}
& itType . iyBase .~ LEFT BLINKER
blinkGun =
defaultLeftItem
{ _itInvColor = cyan
, _itUse =
defaultlUse
& lUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
& eqEq . eqSite .~ GoesOnWrist
-- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
}
& itType . iyBase .~ LEFT BLINKER
unsafeBlinkGun :: Item
unsafeBlinkGun = blinkGun
& itType . iyBase .~ LEFT BLINKERUNSAFE
& itUse . lUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
& itUse . eqEq . eqViewDist ?~ 400
unsafeBlinkGun =
blinkGun
& itType . iyBase .~ LEFT BLINKERUNSAFE
& itUse . lUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
& itUse . eqEq . eqViewDist ?~ 400
--effectGun :: String -> (Creature -> World -> World) -> Item
--effectGun name eff = defaultWeapon
@@ -69,34 +76,36 @@ unsafeBlinkGun = blinkGun
-- }
-- & itType . iyBase .~ AUTOEFFGUN name
forceFieldGun :: Item
forceFieldGun = defaultWeapon
{ _itConsumption = defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField
, _itTargeting = targetRBPress & tgDraw .~ TargetDistanceDraw
, _itParams = ParamMID Nothing
}
& itUse . rUse .~ HeldForceField --useForceFieldGun
& itUse . useDelay .~ NoDelay
& itUse . useMods .~ AmmoHammerTimeUseOneMod -- this is slightly different
forceFieldGun =
defaultWeapon
& itTargeting .~ (targetRBPress & tgDraw .~ TargetDistanceDraw)
& itParams .~ ParamMID Nothing
& itUse . rUse .~ HeldForceField --useForceFieldGun
& itUse . useDelay .~ NoDelay
& itUse . useMods .~ AmmoHammerTimeUseOneMod -- this is slightly different
-- than the list below
--[ hammerCheckI , ammoCheckI , useAmmoAmount 1]
& itType . iyBase .~ HELD FORCEFIELDGUN
& itType . iyBase .~ HELD FORCEFIELDGUN
& itUse . heldConsumption .~ (defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField)
-- I believe because the targeting returns to nothing straight after you release
-- the rmb, it is possible for this to do nothing
-- TODO investigate more and fix
useForceFieldGun :: Item -> Creature -> World -> World
useForceFieldGun itm cr w = fromMaybe w $ do
useForceFieldGun itm cr w = fromMaybe w $ do
a <- _tgPos $ _itTargeting itm
let mwp = mouseWorldPos w
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a,b)
return $ w
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
wlline = (a, b)
return $
w
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
-- grapGun = defaultGun
-- grapGun = defaultGun
-- { _itName = "grapGun"
-- , _itIdentity = GrapGun
-- , _wpMaxAmmo = 1
src/Dodge/Lampoid.hs
+1
View File
@@ -12,6 +12,7 @@ updateLampoid :: Creature -> World -> World
updateLampoid cr w = case cr ^?! crType . lampLSID of
Nothing -> let i = IM.newKey (_lightSources (_cWorld w))
in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
& cWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
Just i
| _crHP cr < 0 -> w
& explosionFlashAt cpos
src/Dodge/LockAndKey.hs
+3 -3
View File
@@ -35,10 +35,10 @@ lockRoomKeyItems =
,(const longRoomRunPast, takeOne [HELD SNIPERRIFLE,HELD FLATSHIELD])
,(const glassLessonRunPast, takeOne [HELD LASGUN])
,(const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD,HELD FORCEFIELDGUN])
,(keyCardRoomRunPast 0, return (KEYCARD 0))
,(keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
]
keyCardRunPastRand :: RandomGen g => [ (Int -> State g (MetaTree Room String) , State g ItemBaseType ) ]
keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ]
keyCardRunPastRand = [(keyCardRoomRunPast 0, return (HELD $ KEYCARD 0)) ]
itemRooms :: RandomGen g => [(ItemBaseType, State g (MetaTree Room String))]
itemRooms =
@@ -76,7 +76,7 @@ itemRooms =
[rc [forceFieldGun]
]
)
, (KEYCARD 0 , join $ takeOne
, (HELD $ KEYCARD 0 , join $ takeOne
[rc [keyCard 0]
]
)
src/Dodge/Luse.hs
+91 -15
View File
@@ -1,9 +1,13 @@
module Dodge.Luse where
import Dodge.Data
import Dodge.Item.Weapon.TriggerType
import Dodge.Base
import Data.Maybe
import Dodge.Creature.Action
import Dodge.Item.Equipment.Booster
import Dodge.Data
import Dodge.Default.Creature
import Dodge.Item.Weapon.TriggerType
import Geometry
import qualified IntMapHelp as IM
import LensHelp
useL :: Luse -> Item -> Creature -> World -> World
@@ -17,25 +21,97 @@ useL lu = case lu of
useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
[w'] -> rewindusing w' [w']
(w':ws) -> rewindusing w' ws
_ -> w
[w'] -> rewindusing w' [w']
(w' : ws) -> rewindusing w' ws
_ -> w
where
rewindusing :: CWorld -> [CWorld] -> World
rewindusing w' ws = w
& cWorld . maybeWorld .~ Just' ( w'
& rewindWorlds .~ ws
)
rewindusing w' ws =
w
& cWorld . maybeWorld
.~ Just'
( w'
& rewindWorlds .~ ws
)
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
-- 22.05.23 this has been changed from using invids to items
useShrinkGun :: Item -> Creature -> World -> World
useShrinkGun it cr w = if _atBool $ _itAttachment it
then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr
useShrinkGun it cr w =
if _atBool $ _itAttachment it
then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr
where
invid = _ipInvID $ _itPos it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus = cWorld . creatures . ix (_crID cr) . crInv . ix invid %~
( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
f isInUse cstatus =
cWorld . creatures . ix (_crID cr) . crInv . ix invid
%~ ((itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus))
boostSelfL ::
-- | boost amount
Float ->
Item ->
Creature ->
World ->
World
boostSelfL x itm cr w = case boostPoint x cr w of
Left p -> crEff p (itUse . leftConsumption . arLoaded .~ 0)
Right p -> crEff p (itUse . leftConsumption . arLoaded -~ 1)
where
invid = _ipInvID $ _itPos itm
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid =
fromMaybe
(IM.newKey $ _props (_cWorld w))
(cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff =
addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& cWorld . creatures . ix cid
%~ (crPos .~ p)
. ( crInv . ix invid
%~ ammoEff
. (itEffect . ieCounter .~ 1)
. (itAttachment .~ AttachInt pid)
)
-- | Move a creature towards the mouse position, with shockwave
boostPoint ::
-- | boost amount
Float ->
Creature ->
World ->
Either Point2 Point2
boostPoint x cr w = case mayp2 of
Nothing -> Right p1
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
addBoostShockwave ::
Int ->
Point2 ->
Point2 ->
World ->
World
addBoostShockwave pjid p v w =
w & cWorld . linearShockwaves
%~ IM.insertWith f pjid thePJ
where
thePJ =
LinearShockwave
{ _lwPos = p
, _lwID = pjid
, _lwPoints = [(p, v)]
, _lwTimer = maxT
}
f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
maxT :: Int
maxT = 20
src/Dodge/Machine/Update.hs
+90 -78
View File
@@ -1,30 +1,31 @@
module Dodge.Machine.Update where
import Dodge.Data
import Dodge.Machine.Destroy
import Dodge.SoundLogic
import Dodge.Base.You
import Dodge.Base.Collide
import Dodge.Wall.Delete
import Dodge.WorldEvent.Explosion
import Dodge.FloorItem
import Dodge.Item.Weapon.BatteryGuns
import Dodge.Default
import Dodge.Movement.Turn
import Geometry
import LensHelp
import qualified IntMapHelp as IM
import Data.List (partition)
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Base.You
import Dodge.Data
import Dodge.Default
import Dodge.FloorItem
import Dodge.Item.Weapon.BatteryGuns
import Dodge.Machine.Destroy
import Dodge.Movement.Turn
import Dodge.SoundLogic
import Dodge.Wall.Delete
import Dodge.WorldEvent.Explosion
import Geometry
import qualified IntMapHelp as IM
import LensHelp
updateMachine :: Machine -> World -> World
updateMachine mc
| _mcHP mc < 1 = destroyMachine mc
| otherwise = mcApplyDamage (_mcDamage mc) mc
. mcPlaySound mc
. mcSensorTriggerUpdate mc
. mcTurretUpdate mc
. mcSensorUpdate mc
| otherwise =
mcApplyDamage (_mcDamage mc) mc
. mcPlaySound mc
. mcSensorTriggerUpdate mc
. mcTurretUpdate mc
. mcSensorUpdate mc
mcTurretUpdate :: Machine -> World -> World
mcTurretUpdate mc = case _mcType mc of
@@ -33,50 +34,57 @@ mcTurretUpdate mc = case _mcType mc of
-- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
& deleteHomonculus
| otherwise = w
& initHomonculus
& dodamage
& maybeFire
& elecDamBranch
updateTurret rotSpeed mc w
| _mcHP mc < 1 =
w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
& deleteHomonculus
| otherwise =
w
& initHomonculus
& dodamage
& maybeFire
& elecDamBranch
where
deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id
Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
Nothing ->
w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
where
cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature
& crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
& itConsumption . laLoaded .~ 1
)
& crPos .~ mcpos
& crOldPos .~ mcpos
& crRad .~ 1
& crDir .~ mcdir
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid -> w'
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = cWorld . machines . ix mcid %~
( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
thecreature =
defaultCreature
& crID .~ cid
& crInv . at 0
?~ ( _tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
& itUse . heldConsumption . laLoaded .~ 1
)
& crPos .~ mcpos
& crOldPos .~ mcpos
& crRad .~ 1
& crDir .~ mcdir
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid ->
w'
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage =
cWorld . machines . ix mcid
%~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
elecDamBranch
| elecDam < 10 = updateFiringStatus . doTurn
| otherwise = id
maybeFire
| _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do
| _tuFireTime (_mcType mc) > 0 =
fromMaybe id $ do
cid <- _tuMCrID (_mcType mc)
return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id
@@ -88,13 +96,13 @@ updateTurret rotSpeed mc w
(elecDams, dams) = partition isElectrical $ _mcDamage mc
dam = sum $ map _dmAmount dams
elecDam = sum $ map _dmAmount elecDams
doTurn
doTurn
| seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| otherwise = id
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
updateFiringStatus
updateFiringStatus
| closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do
@@ -107,59 +115,64 @@ mcTriggerVal mc = case mc ^. mcSensor of
NoSensor -> Nothing
s@ProximitySensor{} -> s ^? sensToggle
s@DamageSensor{} -> Just $ _sensAmount s > 900
mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
Just sid | d < 100
-> soundContinueVol (1-0.01*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
_ -> w
Just sid
| d < 100 ->
soundContinueVol (1 -0.01 * d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
_ -> w
where
d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100)
mid = _mcID mc
mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case _mcSensor mc of
NoSensor -> cWorld . machines . ix (_mcID mc) %~
( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
NoSensor ->
cWorld . machines . ix (_mcID mc)
%~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
_ -> id
mcSensorUpdate :: Machine -> World -> World
mcSensorUpdate mc w = case _mcSensor mc of
NoSensor -> w
s@DamageSensor{} -> senseDamage (_sensType s) mc w
s@DamageSensor{} -> senseDamage (_sensType s) mc w
ProximitySensor{} -> mcProximitySensorUpdate mc w
mcProximitySensorUpdate :: Machine -> World -> World
mcProximitySensorUpdate mc w = case
( _proxStatus sens
, _sensToggle sens
, mcProxTest mc w
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
(_,True,_,_) -> w
(_,False,True,True) -> w
mcProximitySensorUpdate mc w = case ( _proxStatus sens
, _sensToggle sens
, mcProxTest mc w
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens
) of
(_, True, _, _) -> w
(_, False, True, True) ->
w
& cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
& playsound dedaS
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(NotClose,_,False,True) -> w & playsound dedumS
(NotClose, _, False, True) ->
w & playsound dedumS
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(_,_,_,False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
(_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
_ -> w
where
where
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
ycr = you w
sens = _mcSensor mc
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
_ -> False
where
cr = you w
senseDamage :: DamageType -> Machine -> World -> World
senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc)
. updatels
senseDamage dt mc =
(cWorld . machines . ix mcid %~ upmc)
. updatels
where
upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
mcid = _mcID mc
@@ -173,4 +186,3 @@ damageUsing :: DamageType -> Damage -> Either Int Int
damageUsing dt dm
| _dmType dm == dt = Left $ _dmAmount dm
| otherwise = Right 0
src/Dodge/Menu.hs
+127 -106
View File
@@ -1,66 +1,72 @@
module Dodge.Menu
( scodeToChar
, pauseMenu
, gameOverMenu
) where
import Dodge.Config.Data
import LensHelp
import Dodge.Menu.OptionType
import Dodge.StartNewGame
import Dodge.Menu.PushPop
module Dodge.Menu (
scodeToChar,
pauseMenu,
gameOverMenu,
) where
import Dodge.Config.Update
import Dodge.Data
import Dodge.Menu.OptionType
import Dodge.Menu.PushPop
import Dodge.PreloadData
import Dodge.Save
import Dodge.Config.Update
import Padding
--import SDL.Internal.Numbered
--import Preload.Update
import Dodge.SoundLogic
import Dodge.StartNewGame
import LensHelp
import Padding
--import Dodge.LevelGen
import Text.Read
import SDL
import System.Clipboard
import Text.Read
--import Control.Lens
--import System.Random
slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
slTitleOptionsEff title ops eff = OptionScreen
{ _scTitle = const title
, _scOptions = ops
, _scDefaultEff = eff
, _scOptionFlag = NormalOptions
, _scOptionsOffset = 0
}
slTitleOptionsEff title ops eff =
OptionScreen
{ _scTitle = const title
, _scOptions = ops
, _scDefaultEff = eff
, _scOptionFlag = NormalOptions
, _scOptionsOffset = 0
}
pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
pauseMenuOptions :: [MenuOption]
pauseMenuOptions = basicKeyOptions
[ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
, Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
, Toggle (pushScreen optionMenu ) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "CONTROLS")
]
++
[ InvisibleToggle ScancodeEscape (return . const Nothing)
]
pauseMenuOptions =
basicKeyOptions
[ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
, Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "CONTROLS")
]
++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
]
where
opText = const . Left
seedStartMenu :: String -> ScreenLayer
seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
trySeedFromClipboard :: Universe -> IO (Maybe Universe)
trySeedFromClipboard u = do
mcstr <- getClipboardString
case mcstr >>= readMaybe of
Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & menuLayers %~ tail)
Nothing ->
pushScreen
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & menuLayers %~ tail)
Just i -> return . Just $ startSeedGame i u
slTitleOptions :: String -> [MenuOption] -> ScreenLayer
@@ -70,70 +76,84 @@ optionMenu :: ScreenLayer
optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions = basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
]
optionsOptions =
basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
]
debugMenu :: ScreenLayer
debugMenu = slTitleOptions
"OPTIONS:GAMEPLAY"
debugMenuOptions
debugMenu =
slTitleOptions
"OPTIONS:GAMEPLAY"
debugMenuOptions
debugMenuOptions :: [MenuOption]
debugMenuOptions = zipWith ($)
(map f [minBound..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return] )
$ map Scancode [4..]
debugMenuOptions =
zipWith
($)
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return])
$ map Scancode [4 ..]
where
f :: DebugBool -> Scancode -> MenuOption
f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
f bd =
Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
g bd _ = (show bd, "True")
-- zipWith ($)
-- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
-- , makeBoolOption debug_noclip "NOCLIP"
-- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS"
-- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS"
-- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES"
-- , makeBoolOption debug_pathing "SHOW PATHING"
-- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS"
-- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION"
-- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
-- , makeBoolOption debug_noclip "NOCLIP"
-- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS"
-- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS"
-- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES"
-- , makeBoolOption debug_pathing "SHOW PATHING"
-- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS"
-- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION"
-- , makeBoolOption debug_walls "SHOW WALL INFO"
-- , makeBoolOption debug_remove_LOS "REMOVE LOS"
-- , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS"
-- ]
-- $ map Scancode [4 ..]
gameplayMenu :: ScreenLayer
gameplayMenu = slTitleOptions
"OPTIONS:GAMEPLAY"
gameplayMenuOptions
gameplayMenu =
slTitleOptions
"OPTIONS:GAMEPLAY"
gameplayMenuOptions
gameplayMenuOptions :: [MenuOption]
gameplayMenuOptions = basicKeyOptions
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
]
gameplayMenuOptions =
basicKeyOptions
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
]
basicKeyOptions :: [Scancode -> c] -> [c]
basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 .. ]
basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
soundMenu :: ScreenLayer
soundMenu = slTitleOptions
"OPTIONS:VOLUME"
soundMenuOptions
soundMenu =
slTitleOptions
"OPTIONS:VOLUME"
soundMenuOptions
soundMenuOptions :: [MenuOption]
soundMenuOptions =
[ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master
, theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound
, theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music
[ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master
, theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound
, theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music
]
where
theoption scod1 stype scod2 str voltype = Toggle2
scod1
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int)))
theoption scod1 stype scod2 str voltype =
Toggle2
scod1
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
@@ -146,27 +166,28 @@ graphicsMenu :: ScreenLayer
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
graphicsMenuOptions :: [MenuOption]
graphicsMenuOptions = basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
]
graphicsMenuOptions =
basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
]
gameOverMenu :: ScreenLayer
gameOverMenu = OptionScreen
{ _scTitle = const "GAME OVER"
, _scOptions = pauseMenuOptions
, _scDefaultEff = return . Just
, _scOptionFlag = GameOverOptions
, _scOptionsOffset = 0
}
gameOverMenu =
OptionScreen
{ _scTitle = const "GAME OVER"
, _scOptions = pauseMenuOptions
, _scDefaultEff = return . Just
, _scOptionFlag = GameOverOptions
, _scOptionsOffset = 0
}
-- | hacky - no longer used
scodeToChar :: Scancode -> Char
scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
--charToScode :: Char -> Scancode
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
@@ -176,20 +197,20 @@ unpause w = Just . resumeSound $ w & menuLayers .~ []
displayControls :: ScreenLayer
displayControls = ColumnsScreen (const "CONTROLS") listControls
listControls :: [(String,String)]
listControls :: [(String, String)]
listControls =
[("wasd", "MOVEMENT")
,("[rmb]", "AIM")
,("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
,("[lmb]", "USE EQUIPPED")
,("[wheelscroll]" , "SELECT ITEM" )
,("[space]" , "PICKUP ITEM" )
,("m" , "DISPLAY MAP" )
,("f" , "DROP ITEM" )
,("c" , "COMBINE ITEMS" )
,("x" , "TWEAK ITEMS" )
,("c[esc]" , "PAUSE" )
,("qe" , "ROTATE CAMERA")
,("F5" , "QUICKSAVE")
,("F9" , "QUICKLOAD")
[ ("wasd", "MOVEMENT")
, ("[rmb]", "AIM")
, ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
, ("[lmb]", "USE EQUIPPED")
, ("[wheelscroll]", "SELECT ITEM")
, ("[space]", "PICKUP ITEM")
, ("m", "DISPLAY MAP")
, ("f", "DROP ITEM")
, ("c", "COMBINE ITEMS")
, ("x", "TWEAK ITEMS")
, ("c[esc]", "PAUSE")
, ("qe", "ROTATE CAMERA")
, ("F5", "QUICKSAVE")
, ("F9", "QUICKLOAD")
]
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -61,7 +61,7 @@ updateTurret rotSpeed mc w
thecreature = defaultCreature
& crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
& itConsumption . laLoaded .~ 1
& itUse . heldConsumption . laLoaded .~ 1
)
& crPos .~ mcpos
& crOldPos .~ mcpos
src/Dodge/Projectile/Create.hs
+1 -1
View File
@@ -41,7 +41,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
i = IM.newKey $ _props (_cWorld w)
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
am = _itConsumption it
am = _heldConsumption $ _itUse it
--fireShell :: Item -> Creature -> World -> World
--fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
src/Dodge/Projectile/Update.hs
+103 -86
View File
@@ -1,32 +1,33 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update where
import Dodge.Item.Weapon.Launcher
--import qualified Data.Set as S
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Data
import Dodge.Payload
import Dodge.Reloading.Action
import Dodge.EnergyBall
import Dodge.Default.Weapon
import Dodge.EnergyBall
import Dodge.Item.Location
import Dodge.SoundLogic.LoadSound
import Dodge.Item.Weapon.Shell
import Dodge.Item.Weapon.Launcher
import Dodge.Item.Weapon.Remote
import Dodge.Item.Weapon.Shell
import Dodge.Item.Weapon.TriggerType
import Dodge.Movement.Turn
import Dodge.Base
import Dodge.Zone
import Dodge.Payload
import Dodge.Reloading.Action
import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Cloud
import RandomHelp
import Dodge.Zone
import Geometry
import qualified IntMapHelp as IM
import qualified Streaming.Prelude as S
--import qualified Data.Set as S
import qualified Data.Map.Strict as M
import RandomHelp
import qualified SDL
import Data.Maybe
import Control.Lens
import qualified Streaming.Prelude as S
updateProjectile :: Proj -> World -> World
updateProjectile pj = case pj of
@@ -35,65 +36,72 @@ updateProjectile pj = case pj of
updateRemoteShell :: Proj -> World -> World
updateRemoteShell pj w
| time > 340 = if circOnSomeWall oldPos 4 w
then doExplode
else w
| time > 340 =
if circOnSomeWall oldPos 4 w
then doExplode
else w
| anythingHitCirc 2 oldPos newPos w = doExplode
| time > 0 = w
| otherwise = doExplode
where
where
time = _prjTimer pj
doExplode = w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& cWorld . projectiles %~ IM.delete i
doExplode =
w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& cWorld . projectiles %~ IM.delete i
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
explodeRemoteRocket'
:: Maybe Int -- ^ Item id
-> Proj
-> World
-> World
explodeRemoteRocket' mitid thepj w = w
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& usePayload (_prjPayload thepj) (_prjPos thepj)
& updateitem
where
explodeRemoteRocket' ::
-- | Item id
Maybe Int ->
Proj ->
World ->
World
explodeRemoteRocket' mitid thepj w =
w
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& usePayload (_prjPayload thepj) (_prjPos thepj)
& updateitem
where
updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
itid <- mitid
itpos <- w ^? cWorld . itemPositions . ix itid
return $ (pointToItem itpos . itUse . rUse .~ HeldDoNothing)
. (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
return $
(pointerToItem itpos . itUse . rUse .~ HeldDoNothing)
. (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
pjid = _prjID thepj
updateShell :: Proj -> World -> World
updateShell pj w
| time > 340 = if circOnSomeWall oldPos 4 w
then doExplode
else w
| time > 340 =
if circOnSomeWall oldPos 4 w
then doExplode
else w
| anythingHitCirc 2 oldPos newPos w = doExplode
| time > 0 = w
| otherwise = doExplode
where
where
time = _prjTimer pj
doExplode = w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& cWorld . projectiles %~ IM.delete i
doExplode =
w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& cWorld . projectiles %~ IM.delete i
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
upsProjectile :: Proj -> World -> World
upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
upProjectile :: ProjectileUpdate -> Proj -> World -> World
upProjectile pu pj = case pu of
PJThrust st et
PJThrust st et
| act st et -> doThrust' pj
| otherwise -> id
PJSpin t cid spinamount
@@ -115,52 +123,56 @@ upProjectile pu pj = case pu of
ain t = time == t
retireRemoteProj'' :: Int -> Int -> World -> World
retireRemoteProj'' itid pjid w = w
& pointToItem (_itemPositions (_cWorld w) IM.! itid) %~
( (itScope . scopePos .~ V2 0 0)
. (itUse . rUse .~ HeldFireRemoteShell)
)
& cWorld . props %~ IM.delete pjid
retireRemoteProj'' itid pjid w =
w
& pointerToItem (_itemPositions (_cWorld w) IM.! itid)
%~ ( (itScope . scopePos .~ V2 0 0)
. (itUse . rUse .~ HeldFireRemoteShell)
)
& cWorld . props %~ IM.delete pjid
setRemoteDir :: Int -> Int -> Proj -> World -> World
setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir .~ newdir
where
--i = _prjID pj
newdir
newdir
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . itemPositions . ix itid . ipInvID
= _cameraRot (_cWorld w) + argV (_mousePos w)
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . itemPositions . ix itid . ipInvID =
_cameraRot (_cWorld w) + argV (_mousePos w)
| otherwise = _prjDir pj
doThrust' :: Proj -> World -> World
doThrust' pj w = w
& randGen .~ g
& cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
doThrust' pj w =
w
& randGen .~ g
& cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
accel = _prjAcc pj
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
accel = _prjAcc pj
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
(frict, g) = randomR (0.6, 0.9) $ _randGen w
(sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
r1 = randInCirc 10 & evalState $ _randGen w
trySpinByCID'
:: Int -- ^ creature id
-> Int -- ^ Spin amount
-> Proj
-> World
-> World
trySpinByCID' ::
-- | creature id
Int ->
-- | Spin amount
Int ->
Proj ->
World ->
World
trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
where
pjid = _prjID pj
dir = argV $ _prjVel pj
newSpin = case w ^? cWorld . creatures . ix cid of
dir = argV $ _prjVel pj
newSpin = case w ^? cWorld . creatures . ix cid of
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
_ -> 0
spinFactor = 5 * (6 - fromIntegral i)
@@ -170,9 +182,14 @@ pjTrack' itid pj w = rotateToTarget pj w
where
rotateToTarget _ = fromMaybe id $ do
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
return $ cWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
(argV $ _prjAcc pj)
itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
return $
cWorld . projectiles . ix (_prjID pj) . prjSpin
.~ turnToAmount
0.15
(_prjPos pj)
tpos
(argV $ _prjAcc pj)
itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
reduceSpinBy' :: Float -> Proj -> World -> World
reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
src/Dodge/Reloading.hs
+8 -8
View File
@@ -13,7 +13,7 @@ import Control.Lens
crCancelReloading :: Creature -> Creature
crCancelReloading cr = cr
& crInv . ix (crSel cr) . itConsumption . laProgress %~ const Nothing
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress %~ const Nothing
& crInvSel . iselAction .~ NoInvSelAction
stepReloading :: Creature -> Creature
@@ -24,13 +24,13 @@ stepReloading cr = case cr ^?! crInvSel . iselAction of
& crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
| otherwise -> cr
& crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
& crInv . ix (crSel cr) . itConsumption %~ doLoadAction la
& crInv . ix (crSel cr) . itConsumption %~ rotateActionProgress
& crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
& crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress
& tryNextLoadAction
_ -> cr
tryNextLoadAction :: Creature -> Creature
tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just . ix 0 of
tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laProgress . _Just . ix 0 of
Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction
Just la -> cr & crInvSel . iselAction . actionProgress .~ _actionTime la
& crInvSel . iselAction . reloadAction .~ la
@@ -52,22 +52,22 @@ tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType))
Just _ | _laLoaded ic >= _laMax ic -> cr
Just (la:las) -> cr & startLoadAction la
& crInv . ix (crSel cr) . itConsumption . laProgress ?~ (la:las)
& crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la:las)
where
ic = cr ^?! crInv . ix (crSel cr) . itConsumption
ic = cr ^?! crInv . ix (crSel cr) . itUse . heldConsumption
startLoadAction :: LoadAction -> Creature -> Creature
startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
rotateActionProgress :: ItemConsumption -> ItemConsumption
rotateActionProgress :: HeldConsumption -> HeldConsumption
rotateActionProgress ic = case ic ^? laProgress . _Just of
Just (_:la:las) -> ic & laProgress . _Just .~ (la:las)
_ | _laLoaded ic < _laMax ic -> ic & laProgress ?~ _laCycle ic
_ -> ic & laProgress .~ Nothing
doLoadAction :: LoadAction -> ItemConsumption -> ItemConsumption
doLoadAction :: LoadAction -> HeldConsumption -> HeldConsumption
doLoadAction la ic = case la of
LoadEject {} -> ic & laLoaded .~ 0 & laPrimed .~ False
LoadInsert {} -> ic & laLoaded .~ _laMax ic
src/Dodge/Render/HUD.hs
+4 -4
View File
@@ -80,12 +80,12 @@ subInventoryDisplay subinv cfig w = case subinv of
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
TweakInventory -> pictures
TweakInventory mtweaki -> pictures
--[ mCurs it cfig w
[ selcursor' listCursorNESW
-- , cursorsZ cfig curpos it
, fromMaybe mempty $ do
tweaki <- it ^? _Just . itTweaks . tweakSel
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
return $ lnkMidInvSel cfig w curpos tweaki
@@ -234,8 +234,8 @@ lnkMidInvSel cfig w lefti midi = winScale cfig
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
where
f (i:is) = case yourInv w ^? ix i . itConsumption of
Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
f (i:is) = case yourInv w ^? ix i . itUse . useAmount of
Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
_ -> mempty
f _ = mempty
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -27,7 +27,7 @@ import Dodge.Spark.Draw
import Dodge.RadarBlip
import Dodge.Flare
import Dodge.ShortShow
import Dodge.Config.Data
import Dodge.Data.Config
import Dodge.Render.InfoBox
import Dodge.Debug.Picture
import Dodge.Picture.SizeInvariant
src/Dodge/Room/Breather.hs
+15 -36
View File
@@ -1,42 +1,21 @@
module Dodge.Room.Breather where
--import Dodge.Cleat
import Dodge.Combine.Data
import Dodge.Data
--import Dodge.PlacementSpot
--import Dodge.RoomLink
--import Dodge.Default.Room
import Dodge.Item
--import Dodge.Creature
--import Dodge.Room.Pillar
--import Dodge.Room.Girder
--import Dodge.Room.Modify.Girder
--import Dodge.LevelGen.Data
import RandomHelp
import Dodge.Tree
--import Dodge.Placement.Instance
--import Dodge.LevelGen.Data
--import Dodge.Room.Procedural
--import Dodge.Room.Corridor
--import Dodge.Room.Tanks
--import Dodge.Room.Link
--import Dodge.Room.Door
--import Dodge.Room.Airlock
import Dodge.Room.Containing
--import Geometry
--import MonadHelp
--import LensHelp
--import qualified Data.Set as S
import Dodge.Data
import Dodge.Item
import Dodge.Room.Containing
import Dodge.Tree
import RandomHelp
firstBreather :: State StdGen (MetaTree Room String)
firstBreather = do
itms <- takeOne
[[itemFromBase $ CRAFT TUBE]
,[itemFromBase $ CRAFT PIPE]
,[itemFromBase $ CRAFT HARDWARE]
,[itemFromBase $ CRAFT CAN]
,[itemFromBase $ CRAFT TIN]
,[itemFromBase $ CRAFT PLANK]
,[itemFromBase $ CRAFT DRUM]
]
itms <-
takeOne
[ [itemFromBase $ CRAFT TUBE]
, [itemFromBase $ CRAFT PIPE]
, [itemFromBase $ CRAFT HARDWARE]
, [itemFromBase $ CRAFT CAN]
, [itemFromBase $ CRAFT TIN]
, [itemFromBase $ CRAFT PLANK]
, [itemFromBase $ CRAFT DRUM]
]
roomsContaining [] itms
src/Dodge/Room/LasTurret.hs
+1 -1
View File
@@ -65,7 +65,7 @@ keyCardRoomRunPast keyid rmid = do
]
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (HELD (KEYCARD keyid)))
healthAnalyserByDoor :: Int -> Room -> Room
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)

Some files were not shown because too many files have changed in this diff Show More