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

Compare commits

base: justin/loop:1e73565900e1345ce1d2e3123feaa4cd60debe14
Branches Tags
justin/loop:master justin/loop:renameConsole
..
compare: justin/loop:renameConsole
Branches Tags
justin/loop:master justin/loop:renameConsole

1 Commits
1e73565900 .. renameConsole

Author SHA1 Message Date
Ross 56786e7a07 rename debug terminal to console 2025-08-19 13:49:04 +01:00
252 changed files with 505786 additions and 6469 deletions
Expand all files Collapse all files
.gitignore
-2
View File
@@ -4,5 +4,3 @@
loop.cabal
*.lock
keys.json
log/*
generated/*
ChangeLog.md
+3
View File
@@ -0,0 +1,3 @@
# Changelog for loop
## Unreleased changes
README.md
+1
View File
@@ -0,0 +1 @@
# loop
appDodge/Main.hs
+5 -6
View File
@@ -2,7 +2,6 @@ module Main (
main,
) where
import Dodge.StartNewGame
import Control.Lens
import Control.Monad
import Control.Parallel
@@ -10,12 +9,13 @@ import qualified Data.Map.Strict as M
--import Data.Preload.Render
import qualified Data.Text as T
import Dodge.Concurrent
import Dodge.Config
import Dodge.Config.Load
import Dodge.Config.Update
import Dodge.Data
import Dodge.Event
import Dodge.Initialisation
import Dodge.LoadSeed
--import Dodge.Menu
import Dodge.Menu
import Dodge.Render
import Dodge.SoundLogic.LoadSound
import Dodge.TestString
@@ -74,7 +74,7 @@ winConfig x y winpos =
theCleanup :: Universe -> IO ()
theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
firstWorldLoad :: Config -> IO Universe
firstWorldLoad :: Configuration -> IO Universe
firstWorldLoad theConfig = do
SDL.cursorVisible $= False
pdata <- doPreload >>= applyWorldConfig theConfig
@@ -100,8 +100,7 @@ firstWorldLoad theConfig = do
, _uvDebugMessageOffset = 0
, _uvSoundQueue = mempty
}
--return $ u & uvScreenLayers .~ [splashMenu u]
return $ startNewGameInSlot 0 u
return $ u & uvScreenLayers .~ [splashMenu u]
theUpdateStep :: SDL.Window -> Universe -> IO Universe
theUpdateStep win = doSideEffects <=< updateRenderSplit win
asdf
+483
View File
@@ -0,0 +1,483 @@
{- |
Weapon effects when pulling the trigger. -}
module Dodge.Item.Weapon.TriggerType
where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Creature.Action (startReloadingWeapon)
import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
import Dodge.WorldEvent.Cloud
import Dodge.RandomHelp
import Dodge.Particle.Bullet.Spawn
import Dodge.Item.Attachment.Data
import Dodge.Item.Data
import Geometry
import System.Random
import Control.Lens
import Control.Monad.State
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Data.Foldable
withThinSmoke
:: (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World
-> World
withThinSmoke eff cr w = eff cr $ foldl' (flip $ makeThinSmokeAt . (+.+ pos)) w ps
where
dir = _crDir cr
pos = _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir
ps = (replicateM 5 . randInCirc) 8 & evalState $ _randGen w
withThickSmoke
:: (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World
-> World
withThickSmoke eff cr w = eff cr $ foldl' (flip $ makeThickSmokeAt . (+.+ pos)) w ps
where
dir = _crDir cr
pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w
{- |
Fires at an increasing rate.
Has different effect after first fire.
Applies ammo check and use cooldown check. -}
rateIncAB
:: Int -- ^ Start rate
-> Int -- ^ End rate
-> (Creature -> World -> World) -- ^ Effect on first fire
-> (Creature -> World -> World) -- ^ Effect on continued fire
-> Creature -- ^ Creature id
-> World
-> World
rateIncAB startRate fastRate shooteff1 shooteff2 cr w
| repeatFire = w
& pointItem %~ ( (itUseRate .~ max fastRate (currentRate - 1))
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ currentRate) )
& shooteff2 cr
| firstFire = w
& pointItem %~ ( (itUseRate .~ startRate - 1)
. (wpLoadedAmmo -~ 1)
. (itUseTime .~ startRate) )
& shooteff1 cr
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointItem = creatures . ix cid . crInv . ix itRef
currentRate = _itUseRate item
repeatFire = _wpReloadState item == 0
&& _itUseTime item == 1
&& _wpLoadedAmmo item > 0
firstFire = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- |
Shoot a weapon rapidly after a warm up.
Applies ammo check as well. -}
withWarmUp
:: Int -- ^ Warm up time (in frames)
-> (Creature -> World -> World)
-- ^ Shoot effect
-> Creature
-> World
-> World
withWarmUp t f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| _wpReloadState item /= 0 = w
| fState == 0 = w
& pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp 100 f)) . (itUseTime .~ 2) )
| t > 2 = w
& pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp (t-1) f)) . (itUseTime .~ 2) )
& soundFrom (CrWeaponSound cid) 26 2 0
| t > 0 = w
& pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp (t-1) f)) . (itUseTime .~ 2) )
| otherwise = w
& pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp 1 f)) . (wpLoadedAmmo -~ 1) . (itUseTime .~ 2) )
& f cr
& soundFrom (CrWeaponSound cid) 28 2 0
where
cid = _crID cr
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fState = _itUseTime item
reloadCondition = _wpLoadedAmmo item == 0
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
withSound
:: Int -- ^ Sound id
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World -> World
withSound soundid f cr = soundOncePos soundid (_crPos cr) . f cr
withRecoil
:: Float -- ^ Recoil amount
-> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input
-> Creature
-> World -> World
withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
where
cid = _crID cr
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((-recoilAmount) / _crMass cr ) 0))
{- | Pushes a creature sideways by a random amount.
Applied before the underlying effect. -}
withSidePush
:: Float -- ^ Maximal possible side push amount
-> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input
-> Creature
-> World -> World
withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
where
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
-- consider unifying the pushes using a direction vector
{- | Pushes a creature sideways by a random amount.
Applied after the underlying effect. -}
withSidePushAfter
:: Float -- ^ Maximal possible side push amount
-> (Creature -> World -> World)
-- ^ Underlying world effect, takes creature id as input
-> Creature -- ^ Creature id
-> World -> World
withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
where
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- | Applies a world effect and sound effect after an ammo check. -}
shootWithSound
:: Int -- ^ Sound identifier
-> (Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input
-> Creature
-> World
-> World
shootWithSound soundid f cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr)
$ set (pointerToItem . itUseTime) (_itUseRate item)
$ f cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- | Applies a world effect and sound effect after an ammo check. -}
shootWithSoundI
:: Int -- ^ Sound identifier
-> (Item -> Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input
-> Item
-> Creature
-> World
-> World
shootWithSoundI soundid f item cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr)
$ set (pointerToItem . itUseTime) (_itUseRate item)
$ f item cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- |
Applies a world effect after an item use cooldown check. -}
useTimeCheck
:: (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World
-> World
useTimeCheck f cr w = case theItem ^? itUseTime of
Just 0 -> f cr $ setUseTime w
_ -> w
where
cid = _crID cr
setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate
theItem = _crInv cr IM.! _crInvSel cr
useRate = fromMaybe 0 $ theItem ^? itUseRate
{- | Applies a world effect after a hammer position check. -}
hammerCheck
:: (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World
-> World
hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
Just HammerUp -> f cr $ setHammerDown w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | Applies a world effect after a hammer position check. -}
hammerCheckI
:: (Item -> Creature -> World -> World) -- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
hammerCheckI f it cr w = case it ^? itHammer of
Just HammerUp -> f it cr $ setHammerDown w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | Applies a world effect after an ammo check. -}
shoot
:: (Creature -> World -> World)
-- ^ Underlying effect
-> Creature
-> World
-> World
shoot f cr w
| fireCondition = f cr w & pointerToItem %~
( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- | Applies a world effect after a hammer position check.
Arbitrary inventory position. -}
hammerCheckL
:: (Creature -> Int -> World -> World) -- ^ Underlying effect
-> Creature
-> Int
-> World
-> World
hammerCheckL f cr invid w = case (_crInv cr IM.! invid) ^? itHammer of
Just HammerUp -> f cr invid $ setHammerDown w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix invid . itHammer .~ HammerDown
{- | Applies a world effect after an ammo check.
Arbitrary inventory position. -}
shootL
:: (Creature -> Int -> World -> World)
-- ^ Underlying effect
-> Creature
-> Int -- ^ Inventory position
-> World
-> World
shootL f cr invid w
| fireCondition = f cr invid w & pointerToItem %~
( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
item = _crInv cr IM.! invid
pointerToItem = creatures . ix cid . crInv . ix invid
fireCondition = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
withMuzFlare
:: (Creature -> World -> World) -- ^ Underlying effect
-> Creature
-> World
-> World
withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
where
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
withMuzFlareI
:: (Item -> Creature -> World -> World) -- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w
where
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- | Applies the effect to a randomly rotated creature. -}
withRandomDir
:: Float -- ^ Max possible rotation
-> (Creature -> World -> World)
-- ^ Underlying effect
-> Creature
-> World
-> World
withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
where
(a, g) = randomR (-acc,acc) $ _randGen w
{- | Applies the effect to a randomly rotated creature. -}
withRandomDirI
:: Float -- ^ Max possible rotation
-> (Item -> Creature -> World -> World)
-- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w
where
(a, g) = randomR (-acc,acc) $ _randGen w
{- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature
-> Float -- ^ Bullet width
-> HitEffect -- ^ Bullet effect when hitting creature, wall etc
-> Creature -- ^ Creature id
-> World
-> World
withVelWthHiteff vel width hiteff cr = over particles (newbul : )
where
cid = _crID cr
newbul = aGenBulAt (Just cid) pos (rotateV dir vel) hiteff width
dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
{- | Apply the effect to a translated creature. -}
withRandomOffset
:: Float -- ^ Max possible translate
-> (Creature -> World -> World)
-- ^ Underlying effect
-> Creature
-> World
-> World
withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w
where
(offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
offV = rotateV (_crDir cr) (V2 0 offsetVal)
-- | Rotates a creature with minimum rotation at least 0.1.
-- Rotates the player creature before applying the effect, other creatures after.
torqueBeforeForced
:: Float -- ^ Max possible rotation (less the 0.1 forced rotation)
-> (Creature -> World -> World)
-- ^ Underlying effect
-> Creature
-> World
-> World
torqueBeforeForced torque feff cr w
| cid == 0 = feff (cr & crDir +~ rot') $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot'
| otherwise = feff cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
rot' | rot < 0 = rot - 0.1
| otherwise = rot + 0.1
-- | Rotates the player creature before applying an effect.
-- Note this currently (29/4/2021) rotates other creatures /after/ applying the effect.
torqueBefore
:: Float -- ^ Max possible rotation
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature -- ^ Creature id
-> World
-> World
torqueBefore torque feff cr w
| cid == 0 = feff (cr & crDir +~ rot) $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot
& cameraRot +~ rot
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
-- | Rotate a randomly creature after applying an effect.
torqueAfter
:: Float -- ^ Max possible rotation
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature -- ^ Creature id
-> World
-> World
torqueAfter torque feff cr w
| cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cr w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . _Just . scopePos %~ rotateV rot
{- | Create multiple bullets with a given spread, a given amount, given velocity,
given width and given 'HitEffect'. -}
spreadNumVelWthHiteff
:: Float -- ^ Spread
-> Int -- ^ Number of bullets
-> Point2 -- ^ Velocity, x is direction of creature
-> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc
-> Creature -- ^ Creature id
-> World
-> World
spreadNumVelWthHiteff spread num vel wth eff cr w = over particles (newbuls ++) w
where
cid = _crID cr
newbuls = zipWith
(\pos d -> aGenBulAt (Just cid) pos (rotateV d vel) eff wth)
poss dirs
poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
$ (replicateM num . randInCirc) 5 & evalState $ _randGen w
dirs = map (_crDir cr +) $ zipWith (+)
[-spread,-spread+(2*spread/fromIntegral num)..]
(randomRs (0,spread/5) (_randGen w))
{- | Create a number of bullets side by side with a given velocity,
given width and given 'HitEffect'. -}
numVelWthHitEff
:: Int -- ^ Amount of bullets
-> Point2 -- ^ Velocity, x axis is direction of creature
-> Float -- ^ Bullet width
-> HitEffect -- ^ Effect when hitting creature, wall etc
-> Creature
-> World
-> World
numVelWthHitEff num vel wth eff cr = over particles (newbuls ++)
where
cid = _crID cr
newbuls = map (\p -> aGenBulAt (Just cid) p (rotateV d vel) eff wth) poss
d = _crDir cr
poss = map (+.+ pos) $ take num offsets
maxOffset = fromIntegral num * 2.5 - 2.5
offsets = map (rotateV d . V2 0) [-maxOffset,5-maxOffset..]
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: Float -- ^ Max offset angle
-> Float -- ^ Walk speed
-> (Creature -> World -> World) -- ^ Underlying effect
-> Creature -- ^ Creature id
-> World
-> World
randWalkAngle ma aspeed f cr w = w
& f (cr & crDir +~ a)
& creatures . ix cid . crInv . ix i . wpSpread .~ newa
where
cid = _crID cr
a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
(walka, _) = randomR (-aspeed,aspeed) (_randGen w)
newa = min ma $ max (negate ma) (a + walka)
i = _crInvSel $ _creatures w IM.! cid
data/dodge.config.json
+2 -1
View File
@@ -1,7 +1,8 @@
{
"_debug_booleans": [
"Show_ms_frame",
"Pathing"
"Mouse_position",
"Collision_test"
],
"_debug_view_clip_bounds": "NoRoomClipBoundaries",
"_gameplay_rotate_to_wall": true,
graph/itemCombinations.gv
+281
View File
@@ -0,0 +1,281 @@
digraph {
graph [rankdir=LR];
subgraph 1 {
1 [shape=box
,label="EQUIP {_ibtEquip = FUELPACK}"];
5 [shape=box
,label="AMMOMAG {_ibtAmmoMag = TINMAG}"];
9 [shape=box
,label="HELD {_ibtHeld = BANGSTICK {_xNum = 1}}"];
13 [shape=box
,label="HELD {_ibtHeld = PISTOL}"];
15 [shape=box
,label="HELD {_ibtHeld = AUTOPISTOL}"];
17 [shape=box
,label="HELD {_ibtHeld = SMG}"];
20 [shape=box
,label="HELD {_ibtHeld = MACHINEPISTOL}"];
22 [shape=box
,label="HELD {_ibtHeld = BANGCONE}"];
25 [shape=box
,label="HELD {_ibtHeld = BLUNDERBUSS}"];
27 [shape=box
,label="HELD {_ibtHeld = GRAPECANNON {_xNum = 1}}"];
29 [shape=box
,label="HELD {_ibtHeld = RIFLE}"];
31 [shape=box
,label="HELD {_ibtHeld = VOLLEYGUN {_xNum = 3}}"];
33 [shape=box
,label="HELD {_ibtHeld = AUTORIFLE}"];
35 [shape=box
,label="HELD {_ibtHeld = BURSTRIFLE}"];
37 [shape=box
,label="HELD {_ibtHeld = MINIGUNX {_xNum = 3}}"];
40 [shape=box
,label="HELD {_ibtHeld = SNIPERRIFLE}"];
41 [shape=box
,label="HELD {_ibtHeld = AMR}"];
44 [shape=box
,label="HELD {_ibtHeld = AUTOAMR}"];
46 [shape=box
,label="HELD {_ibtHeld = RLAUNCHER}"];
49 [shape=box
,label="HELD {_ibtHeld = RLAUNCHERX {_xNum = 2}}"];
53 [shape=box
,label="HELD {_ibtHeld = FLAMESPITTER}"];
57 [shape=box
,label="HELD {_ibtHeld = BLOWTORCH}"];
59 [shape=box
,label="HELD {_ibtHeld = FLAMETHROWER}"];
61 [shape=box
,label="HELD {_ibtHeld = FLAMEWALL}"];
63 [shape=box
,label="HELD {_ibtHeld = FLAMETORRENT}"];
65 [shape=box,label=LASER];
69 [shape=box
,label="HELD {_ibtHeld = SPARKGUN}"];
71 [shape=box
,label="HELD {_ibtHeld = TESLAGUN}"];
73 [shape=box
,label="HELD {_ibtHeld = BLINKERUNSAFE}"];
74 [shape=box
,label="HELD {_ibtHeld = BLINKER}"];
77 [shape=box
,label="EQUIP {_ibtEquip = MAGSHIELD MagnetRepulse}"];
80 [shape=box
,label="EQUIP {_ibtEquip = POWERLEGS}"];
86 [shape=box
,label="HELD {_ibtHeld = FLATSHIELD}"];
96 [shape=box
,label="DETECTOR {_ibtDetector = ITEMDETECTOR}"];
99 [shape=box
,label="DETECTOR {_ibtDetector = WALLDETECTOR}"];
101 [shape=box
,label="DETECTOR {_ibtDetector = CREATUREDETECTOR}"];
103 [shape=box
,label="HELD {_ibtHeld = TORCH}"];
104 [shape=box
,label="AMMOMAG {_ibtAmmoMag = BATTERY}"];
107 [shape=box
,label="EQUIP {_ibtEquip = HEADLAMP}"];
108 [shape=box
,label="EQUIP {_ibtEquip = HAT}"];
110 [shape=box
,label="HELD {_ibtHeld = BANGSTICK {_xNum = 2}}"];
}
subgraph 2 {
0 [shape=point];
4 [shape=point];
8 [shape=point];
12 [shape=point];
14 [shape=point];
16 [shape=point];
19 [shape=point];
21 [shape=point];
24 [shape=point];
26 [shape=point];
28 [shape=point];
30 [shape=point];
32 [shape=point];
34 [shape=point];
36 [shape=point];
39 [shape=point];
42 [shape=point];
43 [shape=point];
45 [shape=point];
48 [shape=point];
50 [shape=point];
52 [shape=point];
56 [shape=point];
58 [shape=point];
60 [shape=point];
62 [shape=point];
64 [shape=point];
68 [shape=point];
70 [shape=point];
72 [shape=point];
76 [shape=point];
79 [shape=point];
82 [shape=point];
83 [shape=point];
84 [shape=point];
85 [shape=point];
87 [shape=point];
89 [shape=point];
92 [shape=point];
95 [shape=point];
98 [shape=point];
100 [shape=point];
102 [shape=point];
106 [shape=point];
109 [shape=point];
111 [shape=point];
113 [shape=point];
115 [shape=point];
117 [shape=point];
}
0 -> 1 [xlabel="",tailport=e];
4 -> 5 [xlabel="",tailport=e];
8 -> 9 [xlabel="",tailport=e];
9 -> 12 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 28 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 30 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 30 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 30 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 109 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 113 [xlabel=1
,arrowhead=onone
,headport=w];
9 -> 115 [xlabel=1
,arrowhead=onone
,headport=w];
12 -> 13 [xlabel="",tailport=e];
13 -> 14 [xlabel=1
,arrowhead=onone
,headport=w];
14 -> 15 [xlabel="",tailport=e];
15 -> 16 [xlabel=1
,arrowhead=onone
,headport=w];
15 -> 19 [xlabel=1
,arrowhead=onone
,headport=w];
16 -> 17 [xlabel="",tailport=e];
19 -> 20 [xlabel="",tailport=e];
21 -> 22 [xlabel="",tailport=e];
22 -> 24 [xlabel=1
,arrowhead=onone
,headport=w];
24 -> 25 [xlabel="",tailport=e];
25 -> 26 [xlabel=1
,arrowhead=onone
,headport=w];
26 -> 27 [xlabel="",tailport=e];
27 -> 117 [xlabel=1
,arrowhead=onone
,headport=w];
28 -> 29 [xlabel="",tailport=e];
29 -> 32 [xlabel=1
,arrowhead=onone
,headport=w];
29 -> 34 [xlabel=1
,arrowhead=onone
,headport=w];
29 -> 42 [xlabel=1
,arrowhead=onone
,headport=w];
30 -> 31 [xlabel="",tailport=e];
31 -> 36 [xlabel=1
,arrowhead=onone
,headport=w];
31 -> 113 [xlabel=1
,arrowhead=onone
,headport=w];
32 -> 33 [xlabel="",tailport=e];
34 -> 35 [xlabel="",tailport=e];
36 -> 37 [xlabel="",tailport=e];
37 -> 115 [xlabel=1
,arrowhead=onone
,headport=w];
39 -> 40 [xlabel="",tailport=e];
41 -> 39 [xlabel=1
,arrowhead=onone
,headport=w];
41 -> 43 [xlabel=1
,arrowhead=onone
,headport=w];
42 -> 41 [xlabel="",tailport=e];
43 -> 44 [xlabel="",tailport=e];
45 -> 46 [xlabel="",tailport=e];
46 -> 48 [xlabel=1
,arrowhead=onone
,headport=w];
48 -> 49 [xlabel="",tailport=e];
49 -> 50 [xlabel=1
,arrowhead=onone
,headport=w];
52 -> 53 [xlabel="",tailport=e];
53 -> 56 [xlabel=1
,arrowhead=onone
,headport=w];
53 -> 58 [xlabel=1
,arrowhead=onone
,headport=w];
56 -> 57 [xlabel="",tailport=e];
58 -> 59 [xlabel="",tailport=e];
59 -> 60 [xlabel=1
,arrowhead=onone
,headport=w];
59 -> 62 [xlabel=1
,arrowhead=onone
,headport=w];
60 -> 61 [xlabel="",tailport=e];
62 -> 63 [xlabel="",tailport=e];
64 -> 65 [xlabel="",tailport=e];
68 -> 69 [xlabel="",tailport=e];
69 -> 70 [xlabel=1
,arrowhead=onone
,headport=w];
70 -> 71 [xlabel="",tailport=e];
72 -> 73 [xlabel="",tailport=e];
74 -> 72 [xlabel=1
,arrowhead=onone
,headport=w];
76 -> 77 [xlabel="",tailport=e];
79 -> 80 [xlabel="",tailport=e];
85 -> 86 [xlabel="",tailport=e];
95 -> 96 [xlabel="",tailport=e];
98 -> 99 [xlabel="",tailport=e];
100 -> 101 [xlabel=""
,tailport=e];
102 -> 103 [xlabel=""
,tailport=e];
103 -> 106 [xlabel=1
,arrowhead=onone
,headport=w];
104 -> 102 [xlabel=1
,arrowhead=onone
,headport=w];
106 -> 107 [xlabel=""
,tailport=e];
108 -> 106 [xlabel=1
,arrowhead=onone
,headport=w];
109 -> 110 [xlabel=""
,tailport=e];
110 -> 111 [xlabel=1
,arrowhead=onone
,headport=w];
}
log/aGeneratedRoomLayout
+145
View File
@@ -0,0 +1,145 @@
Seed: 7114951007332849727Layout with room names:
rezBox-0
|
autoDoor-1
|
rectPillars-2
|
autoDoor-3
|
Corridor-4
|
autoDoor-5
|
ElecautoRect-6
|
+- triggerDoorRoom-7
| |
| autoDoor-8
| |
| autoDoor-9
| |
| Corridor-10
| |
| autoDoor-11
| |
| 8gon-12
| |
| triggerDoorRoom-13
| |
| autoDoor-14
| |
| autoDoor-15
| |
| Corridor-16
| |
| autoRect-17
| |
| autoDoor-18
| |
| Corridor-19
| |
| autoDoor-20
| |
| 6gon-21
| |
| +- triggerDoorRoom-22
| | |
| | autoDoor-23
| | |
| | autoDoor-24
| | |
| | Corridor-25
| | |
| | autoDoor-26
| | |
| | warningTerm-8gon-27
| | |
| | triggerDoorRoom-28
| | |
| | autoDoor-29
| | |
| | autoDoor-30
| | |
| | Corridor-31
| | |
| | autoRect-32
| | |
| | autoDoor-33
| | |
| | Corridor-34
| | |
| | autoDoor-35
| | |
| | Corridor-36
| | |
| | 8gon-37
| | |
| | triggerDoorRoom-38
| | |
| | autoDoor-39
| | |
| | autoDoor-40
| | |
| | Corridor-41
| | |
| | tanksRoom-42
| | |
| | autoDoor-43
| | |
| | Corridor-44
| | |
| | autoDoor-45
| | |
| | rect-46
| | |
| | +- autoDoor-47
| | | |
| | | autoDoor-48
| | | |
| | | Corridor-49
| | | |
| | | autoRect-50
| | | |
| | | defaultRoom-51
| | | |
| | | autoRect-52
| | | |
| | | defaultRoom-53
| | | |
| | | autoRect-54
| | | |
| | | autoDoor-55
| | | |
| | | Corridor-56
| | | |
| | | autoDoor-57
| | | |
| | | 8gon-58
| | | |
| | | triggerDoorRoom-59
| | | |
| | | autoDoor-60
| | | |
| | | autoDoor-61
| | | |
| | | Corridor-62
| | | |
| | | defaultRoom-63
| | |
| | Corridor-64
| | |
| | autoDoor-65
| |
| autoDoor-66
| |
| Corridor-67
| |
| autoRect-68
|
autoDoor-69
|
Corridor-70
|
autoRect-71
log/attemptedSeeds
+4
View File
@@ -0,0 +1,4 @@
Generating level with seed 7114951007332849727
After 1 attempt(s), Successful generation of level with seed 7114951007332849727
72 rooms in total
log/fullRoomTree
+1139
View File
File diff suppressed because it is too large Load Diff
log/treeCluster
+267
View File
@@ -0,0 +1,267 @@
Seed: 7114951007332849727
0:startThenWeaponRoom
|
1:corDoor
|
2:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
|
3:corDoor
|
4:lasSensorTurretTest
|
5:corDoor
|
6:SingleRoom
|
7:corDoor
|
8:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
|
9:corDoor
|
10:warningRooms
|
11:corDoor
|
12:chaseCrit+armourChaseCrit rectRoom
|
13:corDoor
|
14:healthTest
|
15:corDoor
|
16:empty tanksRoom
|
17:corDoor
|
18:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
|
19:corDoor
|
20:shootingRange
|
21:corDoor
|
22:lasSensorTurretTest
|
23:corDoor
|
24:randomFourCornerRoom
0:0:startThenWeaponRoom
|
0:1:weaponBetweenPillars_BANGSTICK4
0:0:0:rezBox'
0:0:0:0:rezBox
|
0:0:0:1:autoDoor
0:1:0:rectPillars
1:0:corDoor
1:0:0:autoDoor
|
1:0:1:Corridor
2:0:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
2:0:0:RassThroughLockKeyLists
|
2:0:1:roomsContaining chaseCritchaseCritTRANSFORMERCANCAN
2:0:0:0:sensorRoomRunPast
2:0:0:0:0:autoDoor
|
2:0:0:0:1:ElecautoRect
|
+- 2:0:0:0:2:triggerDoorRoom
| |
| 2:0:0:0:3:autoDoor
|
2:0:0:0:4:autoDoor
|
2:0:0:0:5:Corridor
2:0:1:0:autoRect
3:0:corDoor
3:0:0:autoDoor
|
3:0:1:Corridor
4:0:lasSensorTurretTest
4:0:0:autoDoor
|
4:0:1:8gon
|
4:0:2:triggerDoorRoom
|
4:0:3:autoDoor
5:0:corDoor
5:0:0:autoDoor
|
5:0:1:Corridor
6:0:SingleRoom
6:0:0:autoRect
7:0:corDoor
7:0:0:autoDoor
|
7:0:1:Corridor
8:0:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
8:0:0:RassThroughLockKeyLists
|
8:0:1:roomsContaining chaseCritchaseCritchaseCritKEYCARD 0
8:0:0:0:keyCardRoomRunPast
8:0:0:0:0:autoDoor
|
8:0:0:0:1:6gon
|
+- 8:0:0:0:2:triggerDoorRoom
| |
| 8:0:0:0:3:autoDoor
|
8:0:0:0:4:autoDoor
|
8:0:0:0:5:Corridor
8:0:1:0:autoRect
9:0:corDoor
9:0:0:autoDoor
|
9:0:1:Corridor
10:0:warningRooms
10:0:0:autoDoor
|
10:0:1:warningTerm-8gon
|
10:0:2:triggerDoorRoom
|
10:0:3:autoDoor
11:0:corDoor
11:0:0:autoDoor
|
11:0:1:Corridor
12:0:chaseCrit+armourChaseCrit rectRoom
12:0:0:autoRect
13:0:corDoor
13:0:0:autoDoor
|
13:0:1:Corridor
14:0:healthTest
14:0:0:autoDoor
|
14:0:1:Corridor
|
14:0:2:8gon
|
14:0:3:triggerDoorRoom
|
14:0:4:autoDoor
15:0:corDoor
15:0:0:autoDoor
|
15:0:1:Corridor
16:0:empty tanksRoom
16:0:0:tanksRoom
17:0:corDoor
17:0:0:autoDoor
|
17:0:1:Corridor
18:0:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
18:0:0:RassThroughLockKeyLists
|
18:0:1:roomsContaining chaseCritchaseCritSNIPERRIFLE
18:0:0:0:longRoomRunPast
18:0:0:0:0:autoDoor
|
18:0:0:0:1:rect
|
+- 18:0:0:0:2:autoDoor
|
18:0:0:0:3:Corridor
|
18:0:0:0:4:autoDoor
18:0:1:0:rectPillars
19:0:corDoor
19:0:0:autoDoor
|
19:0:1:Corridor
20:0:shootingRange
20:0:0:autoRect
|
20:0:1:defaultRoom
|
20:0:2:autoRect
|
20:0:3:defaultRoom
|
20:0:4:autoRect
21:0:corDoor
21:0:0:autoDoor
|
21:0:1:Corridor
22:0:lasSensorTurretTest
22:0:0:autoDoor
|
22:0:1:8gon
|
22:0:2:triggerDoorRoom
|
22:0:3:autoDoor
23:0:corDoor
23:0:0:autoDoor
|
23:0:1:Corridor
24:0:defaultRoom
moduleFlow.dia
BIN
View File
Binary file not shown.
package.yaml
+3 -3
View File
@@ -6,9 +6,9 @@ author: "Author name here"
maintainer: "example@example.com"
copyright: "2021 Author name here"
# extra-source-files:
# - README.md
# - ChangeLog.md
extra-source-files:
- README.md
- ChangeLog.md
# Metadata used when publishing your package
# synopsis: A basic game loop
saveSlot/0
+1
View File
File diff suppressed because one or more lines are too long
saveSlot/1
+496124
View File
File diff suppressed because it is too large Load Diff
saveSlot/LevelStart0
+1
View File
File diff suppressed because one or more lines are too long
saveSlot/QuickSave
+1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Annotation.hs
+37
View File
@@ -0,0 +1,37 @@
--{-# LANGUAGE TupleSections #-}
{- | Annotating tree structures with desired properties for rooms. -}
module Dodge.Annotation
( module Dodge.Annotation.Data
, module Dodge.Annotation
) where
import Dodge.Cleat
import RandomHelp
import Dodge.Tree
import Dodge.Data.GenWorld
import Dodge.Annotation.Data
import LensHelp
--import Control.Lens
import Data.Maybe
annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS
annoToRoomTree an = case an of
AnTree t -> zoom _1 t
AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ()) <$> zoom _1 r <*> return []
OnwardList ans -> do
mts <- mapM annoToRoomTree ans
return $ foldr1 attachOnward' mts
IntAnno f -> do
(g,i) <- get
put (g,i+1)
annoToRoomTree (f i)
ModifyTree f a -> f <$> annoToRoomTree a
PassthroughLockKeyLists ls ks i -> zoom _1 $ do
(functionlockroom,randomitemidentity) <- takeOne ls
lr <- functionlockroom i
ii <- randomitemidentity
keyroom <- fromJust $ lookup ii ks
return $ MTree ("PassthroughLockKeyLists-"++show ii)
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
[]
src/Dodge/Annotation/Data.hs
+25
View File
@@ -0,0 +1,25 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Annotation.Data where
import Control.Lens
import Control.Monad.State
import Dodge.Data.GenWorld
import Dodge.Data.MetaTree
import System.Random
type MTRS = MetaTree Room String
data Annotation
= ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation
| OnwardList [Annotation]
| IntAnno (Int -> Annotation)
| AnRoom (State StdGen Room)
| AnTree (State StdGen (MetaTree Room String))
| PassthroughLockKeyLists
[(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
[(ItemType, State StdGen (MetaTree Room String))]
Int
makeLenses ''Annotation
src/Dodge/AssignHotkey.hs
+11 -8
View File
@@ -1,18 +1,21 @@
module Dodge.AssignHotkey (assignHotkey) where
module Dodge.AssignHotkey (
assignHotkey,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Maybe
import Dodge.Data.Equipment.Misc
import Dodge.Data.World
import NewInt
-- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or
-- World
assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld
assignHotkey i hk lw =
lw
assignHotkey (NInt itid) hk lw = lw
& handleoldposition
& hotkeys . at hk ?~ i
& imHotkeys . at i ?~ hk
& hotkeys . at hk ?~ NInt itid
& imHotkeys . unNIntMap . at itid ?~ hk
where
handleoldposition = fromMaybe id $ do
oldi <- lw ^? hotkeys . ix hk
return $ imHotkeys . at oldi .~ Nothing
olditid <- lw ^? hotkeys . ix hk . unNInt
return $ imHotkeys . unNIntMap . at olditid .~ Nothing
src/Dodge/Barreloid.hs
+11 -14
View File
@@ -18,33 +18,30 @@ updateBarreloid = \case
PlainBarrel -> updateBarrel
updateExpBarrel :: [Point2] -> Creature -> World -> World
updateExpBarrel ps cr w = case cr ^. crHP of
HP x | x > 0 ->
updateExpBarrel ps cr w
| cr ^. crHP > 0 =
w
& hiss
& cWorld . lWorld . creatures . ix (_crID cr) %~ damsToExpBarrel damages
& cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP
& cWorld . lWorld . creatures . ix (_crID cr) . crHP
-~ length (_piercedPoints . _barrelType $ _crType cr)
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ mempty
& flip (foldl' f) ps
HP _ ->
| otherwise =
w
& makeExplosionAt ((cr ^. crPos) `v2z` 20) 0
& cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
_ -> w
& cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
where
f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos) (argV p) w'
damages = cr ^. crDamage
hiss
| null ps = id
| otherwise = soundContinue
(BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1)
| otherwise = soundContinue (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1)
updateBarrel :: Creature -> World -> World
updateBarrel cr = case cr ^. crHP of
HP x | x > 0 -> doDamage (cr ^. crID)
HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
_ -> id
updateBarrel cr
| _crHP cr > 0 = doDamage (cr ^. crID)
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
damsToExpBarrel :: [Damage] -> Creature -> Creature
damsToExpBarrel = flip $ foldl' damToExpBarrel
@@ -52,8 +49,8 @@ damsToExpBarrel = flip $ foldl' damToExpBarrel
damToExpBarrel :: Creature -> Damage -> Creature
damToExpBarrel cr dm = case dm of
Piercing x p _ ->
cr & crHP . _HP -~ div x 200
cr & crHP -~ div x 200
& crType . barrelType . piercedPoints .:~ (p - _crPos cr)
Poison{} -> cr
Sparking{} -> cr
_ -> cr & crHP . _HP -~ fromMaybe 0 (dm ^? dmAmount)
_ -> cr & crHP -~ fromMaybe 0 (dm ^? dmAmount)
src/Dodge/Base/CardinalPoint.hs
-8
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Base.CardinalPoint where
import Dodge.Data.Room
@@ -24,10 +23,3 @@ cardEightVec cp = case cp of
SouthWest8 -> V2 (-1) (-1)
West8 -> V2 (-1) 0
NorthWest8 -> V2 (-1) 1
cardinalBetweenAdj :: CardinalPointBetween -> (CardinalPoint,CardinalPoint)
cardinalBetweenAdj = \case
NorthEast -> (North,East)
SouthEast -> (South,East)
SouthWest -> (South,West)
NorthWest -> (North,West)
src/Dodge/Base/Collide.hs
+1 -1
View File
@@ -143,7 +143,7 @@ collide3Floors sp cs (ep, mn) = maybe (ep, mn) (,Just (V3 0 0 1, OFloor)) mp
let g (a, b) = isRHS a b (V2 x y)
f = any g
guard (all (f . loopPairs) cs)
return (V3 x y z)
return $ (V3 x y z)
collide3Wall :: Point3 -> Wall -> (Point3, MPO) -> (Point3, MPO)
collide3Wall sp wl (ep, mo) = maybe (ep, mo) (,Just (n, OWall wl)) $ intersectSegSurface sp ep p n ss
src/Dodge/Base/Coordinate.hs
+35 -2
View File
@@ -1,4 +1,5 @@
module Dodge.Base.Coordinate (
cartePosToScreen,
worldPosToScreen,
screenToWorldPos,
mouseWorldPos,
@@ -6,9 +7,18 @@ module Dodge.Base.Coordinate (
import Control.Lens
import Dodge.Data.Camera
import Dodge.Data.HUD
import Dodge.Data.Input
import Geometry
---- | Transform coordinates from world position to screen coordinates.
--worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
--worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
-- where
-- doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)
-- doZoom p = (w ^. cWorld . lWorld . wCam . cwcZoom) *.* p
-- doRotate p = rotateV (negate (w ^. cWorld . lWorld . wCam . cwcRot)) p
{- | Transform world coordinates to scaled screen coordinates.
- These have to be scaled according to the size of the window to get actual screen positions.
- This allows for line thicknesses etc to correspond to pixel sizes.
@@ -21,10 +31,33 @@ worldPosToScreen cam =
. ((cam ^. camZoom) *.*)
. (-.- (cam ^. camCenter))
{- | Transform coordinates from the map position to screen
coordinates.
-}
cartePosToScreen :: HUD -> Point2 -> Point2
cartePosToScreen thehud = doRotate . doZoom . doTranslate
where
doTranslate p = p - (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
doZoom p = (thehud ^. carteZoom) *.* p
doRotate p = rotateV (negate $ thehud ^. carteRot) p
--crToMousePosOffset :: Creature -> World -> (Point2, Float)
--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-- | The mouse position in world coordinates.
mouseWorldPos :: Input -> Camera -> Point2
mouseWorldPos inp cam = screenToWorldPos cam (inp ^. mousePos)
screenToWorldPos :: Camera -> Point2 -> Point2
screenToWorldPos cam p =
(cam ^. camCenter) + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
screenToWorldPos cam p =
(cam ^. camCenter)
+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2
--mouseCartePos w = (thehud ^. carteCenter)
-- +.+
-- (1 / (thehud ^. carteZoom))
-- *.* rotateV (thehud ^. carteRot) (_mousePos w)
-- where
-- thehud = w ^. cWorld . lWorld . hud
src/Dodge/Base/NewID.hs
+9 -2
View File
@@ -4,13 +4,20 @@ import LensHelp
-- | generalised way of putting a new item into a lensed intmap, returning the
-- new index as well
plNewID :: ALens' b (IM.IntMap a) -> a -> b -> (Int,b)
plNewID :: ALens' b (IM.IntMap a)
-> a
-> b
-> (Int,b)
plNewID l x w = (i,w & l #%~ IM.insert i x)
where
i = IM.newKey $ w ^# l
-- | place an new object into an intmap and update its id
plNewUpID :: ALens' b (IM.IntMap a) -> ALens' a Int -> a -> b -> (Int,b)
plNewUpID :: ALens' b (IM.IntMap a)
-> ALens' a Int
-> a
-> b
-> (Int,b)
plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
where
i = IM.newKey $ w ^# l
src/Dodge/Base/Window.hs
+6 -6
View File
@@ -14,7 +14,7 @@ import Dodge.Data.Config
import Geometry
-- | A box covering the screen in world coordinates
screenPolygon :: Config -> Camera -> [Point2]
screenPolygon :: Configuration -> Camera -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
where
scRot = rotateV (w ^. camRot)
@@ -29,7 +29,7 @@ screenPolygonBord ::
Float ->
-- | Y border
Float ->
Config ->
Configuration ->
Camera ->
[Point2]
screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
@@ -45,16 +45,16 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
br = theTransform (V2 hw (- hh))
bl = theTransform (V2 (- hw) (- hh))
halfWidth, halfHeight :: Config -> Float
halfWidth, halfHeight :: Configuration -> Float
halfWidth = (0.5 *) . windowXFloat
halfHeight = (0.5 *) . windowYFloat
-- | A box of the size of the screen in screen centered coordinates
screenBox :: Config -> [Point2]
screenBox :: Configuration -> [Point2]
screenBox w = rectNSWE hh (- hh) (- hw) hw
where
hw = halfWidth w
hh = halfHeight w
pointIsOnScreen :: Config -> Camera -> Point2 -> Bool
pointIsOnScreen cfig = flip pointInPoly . screenPolygon cfig
pointIsOnScreen :: Configuration -> Camera -> Point2 -> Bool
pointIsOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
src/Dodge/Base/You.hs
+5 -8
View File
@@ -5,9 +5,8 @@ module Dodge.Base.You
, yourRootItem
)where
import NewInt
import Dodge.Data.World
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
import Control.Lens
you :: World -> Creature
@@ -16,15 +15,13 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
yourSelectedItem :: World -> Maybe Item
yourSelectedItem w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
j <- _crInv (you w) ^? ix i
w ^? cWorld . lWorld . items . ix j
_crInv (you w) IM.!? i
yourRootItem :: World -> Maybe Item
yourRootItem w = do
i <- you w ^? crManipulation . manObject . imRootSelectedItem
j <- _crInv (you w) ^? ix i
w ^? cWorld . lWorld . items . ix j
_crInv (you w) IM.!? i
yourInv :: World -> NewIntMap InvInt Item
yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
yourInv :: World -> IM.IntMap Item
yourInv = _crInv . you
src/Dodge/BaseTriggerType.hs
+1 -1
View File
@@ -62,7 +62,7 @@ heldTriggerType = \case
GLAUNCHER -> SemiAutoTrigger 20
POISONSPRAYER -> NoTrigger
SHATTERGUN -> SemiAutoTrigger 20
LED -> NoTrigger
TORCH -> NoTrigger
FLATSHIELD -> NoTrigger
KEYCARD{} -> NoTrigger
BLINKER -> SemiAutoTrigger 20
src/Dodge/Bullet.hs
+5 -6
View File
@@ -1,6 +1,5 @@
module Dodge.Bullet (updateBullet) where
import qualified Data.IntMap.Strict as IM
import Dodge.Damage
import Data.Bifunctor
import Data.Foldable
@@ -106,10 +105,10 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
-- tpos <- cr ^? crTargeting . ctPos . _Just
-- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
bounceDir _ (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
bounceDir m (p, Left cr) | crIsArmouredFrom m p cr = Just $ vNormal $ p - _crPos cr
bounceDir _ _ = Nothing
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 _ = Nothing
useBulletPayload :: Bullet -> Point2 -> World -> World
useBulletPayload bu = case _buPayload bu of
@@ -155,7 +154,7 @@ hitEffFromBul w bu = case _buEffect bu of
PenetrateBullet -> movePenBullet bu hitstream w
BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
(hp, crwl) <- hitstream ^? _head
dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
dir <- bounceDir (hp, crwl)
return
( w
, bu
src/Dodge/Bullet/Draw.hs
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Bullet.Draw (
drawBullet,
) where
import Dodge.Data.Bullet
import Linear
import Picture
drawBullet :: Bullet -> Picture
drawBullet pt =
setLayer BloomLayer
. setDepth 20
. color (V4 200 200 200 2)
$ thickLine 2 [_buOldPos pt, _buPos pt]
src/Dodge/Button/Draw.hs
+2 -1
View File
@@ -11,7 +11,8 @@ drawButton :: Button -> SPic
drawButton bt = case bt ^. btEvent of
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
ButtonAccessTerminal _ -> mempty
ButtonAccessTerminal -> mempty
-- ButtonDoNothing -> mempty
drawSwitch :: Color -> Color -> Button -> SPic
drawSwitch col1 col2 bt
src/Dodge/Button/Event.hs
+3 -2
View File
@@ -5,6 +5,7 @@ import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Dodge.WorldEffect
import Sound.Data
doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent = \case
@@ -12,10 +13,10 @@ doButtonEvent = \case
ButtonPress False f _ -> buttonFlip f
ButtonSwitch _ f _ _ True -> buttonFlip f
ButtonSwitch f _ _ _ False -> buttonFlip f
ButtonAccessTerminal tid -> const $ accessTerminal tid
ButtonAccessTerminal -> accessTerminal . _btTermMID
buttonFlip :: WdWd -> Button -> World -> World
buttonFlip f bt =
doWdWd f
. soundStart (ButtonSound (bt ^. btID)) (bt ^. btPos) click1S Nothing
. soundWithStatus ToStart (LeverSound 0) (bt ^. btPos) click1S Nothing
. over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not
src/Dodge/Cleat.hs
+12 -12
View File
@@ -1,25 +1,25 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Cleat (
toLabel,
cleatOnward,
cleatSide,
rToOnward,
cleatLabel,
) where
import Control.Lens
import qualified Data.Set as S
import Data.Tree
module Dodge.Cleat
( toLabel
, cleatOnward
, cleatSide
, rToOnward
, cleatLabel
) where
import Dodge.Data.GenWorld
import Dodge.Tree.Compose
import Data.Tree
import Control.Lens
import qualified Data.Set as S
toLabel :: Int -> Room -> Maybe Room
toLabel i rm
| LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just rm
| otherwise = Nothing
rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room String)
rToOnward s = return . tToBTree s
rToOnward s t = return $ tToBTree s t
cleatOnward :: Room -> Room
cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
src/Dodge/Clock.hs
+3 -1
View File
@@ -1,4 +1,6 @@
module Dodge.Clock (clockCycle) where
module Dodge.Clock (
clockCycle,
) where
import Control.Lens
import qualified Data.Vector as V
src/Dodge/Combine.hs
+5 -6
View File
@@ -1,7 +1,6 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Combine (combineList) where
import NewInt
import Dodge.Data.CombAmount
import Dodge.Item.InvSize
import Dodge.Item.Grammar
@@ -18,22 +17,22 @@ import Dodge.Item.InventoryColor
import qualified IntMapHelp as IM
import SimpleTrie
combineList :: World -> [SelectionItem CombItem]
combineList :: World -> [SelectionItem CombinableItem]
combineList = map f . combineItemListYouX
where
f (is, itm) =
SelItem
SelectionItem
{ _siPictures = basicItemDisplay itm
, _siHeight = itInvHeight itm
, _siWidth = 15
, _siIsSelectable = True
, _siColor = itemInvColor $ baseCI itm
, _siOffX = 2
, _siPayload = Just $ CombItem is itm
, _siOffX = 0
, _siPayload = CombinableItem is itm
}
combineItemListYouX :: World -> [([Int], Item)]
combineItemListYouX = map (first concat) . flatLookupItems . _unNIntMap . yourInv
combineItemListYouX = map (first concat) . flatLookupItems . yourInv
flatLookupItems :: IM.IntMap Item -> [([[Int]], Item)]
flatLookupItems =
src/Dodge/Combine/Combinations.hs
+2 -2
View File
@@ -108,8 +108,8 @@ itemCombinations =
, po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (detector ITEMDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (detector WALLDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR] (detector CREATUREDETECTOR)
-- , po [AMMOMAG BATTERY, cr LED] torch
, po [hd LED, eq HAT] headLamp
, po [AMMOMAG BATTERY, cr LED] torch
, po [hd TORCH, eq HAT] headLamp
-- , po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (energyBallCraft IncBall)
-- , po [cr TRANSFORMER, AMMOMAG BATTERY, cr MICROCHIP] (energyBallCraft TeslaBall)
]
src/Dodge/Concurrent.hs
+1 -1
View File
@@ -59,7 +59,7 @@ loadingScreen str =
{ _scTitle = str
, _scOptions = mempty
, _scOffset = 0
, _scPositionedMenuOption = NoExtraMenuOption
, _scPositionedMenuOption = NoEscapeMenuOption
, _scOptionFlag = LoadingScreen
, _scSelectionList = mempty
, _scAvailableLines = 0
src/Dodge/Config/Load.hs
+22
View File
@@ -0,0 +1,22 @@
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"
return defaultConfig
else do
putStrLn "No data/data/dodge.config.json found, loading defaults"
return defaultConfig
src/Dodge/Config.hs → src/Dodge/Config/Update.hs
+6 -23
View File
@@ -1,50 +1,33 @@
{- |
IO actions that apply config side effects and save configuration settings to disk.
-}
module Dodge.Config (
module Dodge.Config.Update (
saveConfig,
applyWorldConfig,
setVol,
loadDodgeConfig,
) where
import Data.Aeson
import qualified Data.Aeson.Encode.Pretty as AEP
import qualified Data.ByteString.Lazy as BS
import Data.Preload
import Dodge.Data.Config
import Preload.Update
import Sound
import System.Directory
{- |
Write the current world configuration to disk as a json file.
-}
saveConfig :: Config -> (a -> IO a) -> a -> IO a
saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
saveConfig cfig f x = do
createDirectoryIfMissing True "generated"
BS.writeFile "generated/config.json" $
-- 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
f x
loadDodgeConfig :: IO Config
loadDodgeConfig = do
fExists <- doesFileExist "generated/config.json"
if fExists
then do
mconfig <- decodeFileStrict "generated/config.json"
maybe
(failstr "invalid generate/config.json, loading defaults")
return
mconfig
else failstr "No generated/config.json found, loading defaults"
where
failstr s = putStrLn s >> return defaultConfig
{- |
Apply the volume settings from the world configuration to the running game.
-}
setVol :: Config -> IO ()
setVol :: Configuration -> IO ()
setVol cfig = do
setSoundVolume (_volume_master cfig * _volume_sound cfig)
setMusicVolume (_volume_master cfig * _volume_music cfig)
@@ -53,7 +36,7 @@ setVol cfig = do
Apply /all/ of the values in the world configuration to the running game.
-}
applyWorldConfig ::
Config ->
Configuration ->
PreloadData ->
IO PreloadData
applyWorldConfig cfig pdata = do
src/Dodge/Corpse/Draw.hs
+7
View File
@@ -0,0 +1,7 @@
module Dodge.Corpse.Draw where
import Dodge.Data.Corpse
import ShapePicture
-- not currently used, too simple
drawCorpse :: Corpse -> SPic
drawCorpse = _cpSPic
src/Dodge/Corpse/Make.hs
+30 -12
View File
@@ -1,25 +1,43 @@
module Dodge.Corpse.Make (makeCorpse) where
import Control.Lens
import Dodge.Creature.Picture
import Dodge.Creature.Radius
import Dodge.Creature.Shape
--import Dodge.Data.Corpse
import Control.Lens
import Dodge.Creature.Picture
import Dodge.Data.Corpse
import Dodge.Data.Creature
import Geometry
import Shape
import ShapePicture
makeCorpse :: Creature -> SPic
makeCorpse cr =
noPic
. scaleSH (V3 crsize crsize crsize)
$ mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
makeCorpse :: Creature -> Corpse
makeCorpse = makeDefaultCorpse
makeDefaultCorpse :: Creature -> Corpse
makeDefaultCorpse cr =
defaultCorpse
& cpPos .~ _crPos cr
& cpDir .~ _crDir cr
& cpSPic
.~ noPic
( scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
)
where
cskin = crShape $ _crType cr -- this should be fixed
crsize = 0.1 * crRad (cr ^. crType)
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
defaultCorpse :: Corpse
defaultCorpse =
Corpse
{ _cpID = 0
, _cpPos = 0
, _cpDir = 0
, _cpSPic = mempty
, _cpRes = NoResurrection
}
src/Dodge/Creature.hs
+31 -31
View File
@@ -3,7 +3,7 @@ module Dodge.Creature (
module Dodge.Creature.ChaseCrit,
module Dodge.Creature.Inanimate,
launcherCrit,
-- pistolCrit,
pistolCrit,
ltAutoCrit,
spreadGunCrit,
autoCrit,
@@ -38,6 +38,7 @@ import Dodge.Creature.Inanimate
import Dodge.Creature.LauncherCrit
import Dodge.Creature.LtAutoCrit
import Dodge.Creature.Perception
import Dodge.Creature.PistolCrit
import Dodge.Creature.ReaderUpdate
import Dodge.Creature.SentinelAI
import Dodge.Creature.SpreadGunCrit
@@ -56,35 +57,35 @@ import Picture
spawnerCrit :: Creature
spawnerCrit =
defaultCreature
& crHP .~ HP 300
-- & crInv .~ IM.empty
& crHP .~ 300
& crInv .~ IM.empty
-- & crType . skinUpper .~ lightx4 blue
miniGunCrit :: Creature
miniGunCrit =
defaultCreature
-- & crInv .~ IM.fromList [(0, miniGunX 3)]
& crInv .~ IM.fromList [(0, miniGunX 3)]
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ MiniGunAI
longCrit :: Creature
longCrit =
defaultCreature
-- & crInv .~ IM.fromList [(0, sniperRifle)]
& crInv .~ IM.fromList [(0, sniperRifle)]
-- & crType . humanoidAI .~ LongAI
-- & crType . skinUpper .~ lightx4 red
multGunCrit :: Creature
multGunCrit =
defaultCreature
-- & crInv .~ IM.fromList [(0, volleyGun 4)]
& crInv .~ IM.fromList [(0, volleyGun 4)]
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ MultGunAI
addArmour :: Creature -> Creature
addArmour = over crInv insarmour
where
insarmour xs = xs -- IM.insert (IM.newKey xs) frontArmour xs
insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
{- | The creature you control.
ID 0.
@@ -97,8 +98,8 @@ startCr =
& crDir .~ pi / 2
& crMvDir .~ pi / 2
& crID .~ 0
& crHP .~ HP 10000
& crInv .~ mempty
& crHP .~ 10000
& crInv .~ startInventory
& crFaction .~ PlayerFaction
-- & crMvType .~ MvWalking yourDefaultSpeed
& crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
@@ -110,9 +111,9 @@ startInvList = []
startInventory :: IM.IntMap Item
startInventory = IM.fromList $ zip [0 ..] startInvList
inventoryX :: String -> [Item]
inventoryX :: Char -> [Item]
inventoryX c = case c of
"A" ->
'A' ->
[introScan t | t <- [minBound..maxBound]] <>
[ flameThrower
, fuelPack
@@ -122,7 +123,7 @@ inventoryX c = case c of
, unigate
, bingate
]
"B" ->
'B' ->
[ wristArmour
, wristArmour
, volleyGun 5
@@ -146,16 +147,15 @@ inventoryX c = case c of
, makeTypeCraftNum 2 PIPE
, makeTypeCraftNum 1 CREATURESENSOR
]
"BB" -> [ wristArmour , wristArmour]
"C" -> map makeTypeCraft [minBound..maxBound]
"D" ->
'C' -> map makeTypeCraft [minBound..maxBound]
'D' ->
[ blinker
, unsafeBlinker
, pulseChecker
, detector WALLDETECTOR
, battery
]
"E" -> [alteRifle
'E' -> [alteRifle
, tinMag
, tinMag
] <>
@@ -166,7 +166,7 @@ inventoryX c = case c of
, makeTypeCraftNum 1 STEELDRUM
, makeTypeCraftNum 1 MOTOR
]
"F" -> fold
'F' -> fold
[ makeTypeCraftNum 3 PIPE
, makeTypeCraftNum 3 TUBE
, makeTypeCraftNum 3 HARDWARE
@@ -183,7 +183,7 @@ inventoryX c = case c of
, makeTypeCraftNum 3 LIGHTER
-- , makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
]
"G" ->
'G' ->
[ autoPistol
, tinMag
, pistol
@@ -197,19 +197,19 @@ inventoryX c = case c of
-- , makeTypeCraftNum 5 (BULBODYCRAFT BounceBullet)
-- , makeTypeCraftNum 5 (BULBODYCRAFT PenetrateBullet)
]
"H" -> [shatterGun]
"I" ->
'H' -> [shatterGun]
'I' ->
[ makeTypeCraft HARDDRIVE
, makeTypeCraft RAM
] <> fold
[ makeTypeCraftNum 2 MICROCHIP
]
"J" ->
'J' ->
[ laser
, battery
--, dualBeam
] <> makeTypeCraftNum 10 TRANSFORMER
"K" ->
'K' ->
[ autoRifle
, tinMag
] <> fold
@@ -222,14 +222,14 @@ inventoryX c = case c of
, makeTypeCraftNum 1 SOUNDSENSOR
, makeTypeCraftNum 1 HEATSENSOR
]
"L" -> [burstRifle
'L' -> [burstRifle
,tinMag
, bulletSynthesizer
, battery
]
"M" -> stackedInventory
"N" -> [zoomScope,laser,battery, sniperRifle, tinMag]
"O" -> [ rLauncherX 2
'M' -> stackedInventory
'N' -> [zoomScope,laser,battery, sniperRifle, tinMag]
'O' -> [ rLauncherX 2
, shellMag
, shellMag
, rLauncherX 3
@@ -239,9 +239,9 @@ inventoryX c = case c of
, rifle
, shellMag
]
"P" -> [burstRifle , tinMag, bulletSynthesizer, battery]
"T" -> testInventory
"U" ->
'P' -> [burstRifle , tinMag, bulletSynthesizer]
'T' -> testInventory
'U' ->
[targetingScope tt | tt <- [minBound .. maxBound]]
<>
[ gyroscope
@@ -267,7 +267,7 @@ inventoryX c = case c of
, stickyMod
]
<> [shellModule p | p <- [minBound .. maxBound]]
"V" ->
'V' ->
[targetingScope tt | tt <- [minBound .. maxBound]]
<>
[ battery
@@ -319,7 +319,7 @@ stackedInventory =
, megaBattery
, gLauncher
, megaShellMag
, led
, torch
, magShield MagnetRepulse
, bangCone
, megaTinMag 1000
src/Dodge/Creature/Action.hs
+9 -15
View File
@@ -13,7 +13,6 @@ module Dodge.Creature.Action (
youDropItem,
) where
import NewInt
import Dodge.Creature.MoveType
import Dodge.Creature.Radius
import Dodge.Item.BackgroundEffect
@@ -167,41 +166,36 @@ performAction cr w ac = case ac of
dropExcept :: Creature -> Int -> World -> World
dropExcept cr invid w =
foldr (dropItem cr) w . IM.keys $
-- invid `IM.delete` _crInv cr
invid `IM.delete` _unNIntMap (_crInv cr)
invid `IM.delete` _crInv cr
-- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World
dropItem cr invid w' =
dropItem cr invid =
doanyitemdropeffect
. maybeshiftseldown
. rmInvItem (_crID cr) invid
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. rmInvItem (_crID cr) (NInt invid) -- it is important
-- to do this before copying the item to the floor!
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
$ w'
where
--doanyitemdropeffect = fromMaybe id $ do
-- rmf <- itm ^? itEffect . ieOnDrop
-- return $ doInvEffect rmf itm cr
doanyitemdropeffect = itEffectOnDrop itm cr
itm = fromMaybe (error "dropItem cannot find item") $ do
itid <- cr ^? crInv . ix (NInt invid)
w' ^? cWorld . lWorld . items . ix itid
itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
maybeshiftseldown w = fromMaybe w $ do
3 <- w ^? hud . diSelection . _Just . slSec
return $ w & hud . diSelection . _Just . slInt +~ 1
3 <- w ^? hud . hudElement . diSelection . _Just . _1
return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
cr ^? crManipulation . manObject . imSelectedItem . unNInt
<|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
cr ^? crManipulation . manObject . imSelectedItem
<|> fmap fst (IM.lookupMax (cr ^. crInv))
--guard $ not $ _crInvLock cr
guard $ not $ w ^. cWorld . lWorld . lInvLock
return $ case cr ^. crStance . posture of
Aiming {} -> throwItem w
Aiming -> throwItem w
AtEase -> dropItem cr curpos w
where
cr = you w
src/Dodge/Creature/ArmourChase.hs
+15 -15
View File
@@ -3,23 +3,23 @@ module Dodge.Creature.ArmourChase (
flockArmourChaseCrit,
) where
--import Dodge.Data.Equipment.Misc
--import Control.Lens
import Dodge.Data.Equipment.Misc
import Control.Lens
import Dodge.Creature.ChaseCrit
import Dodge.Data.Creature
import Dodge.Default
--import Dodge.Item.Equipment
--import qualified IntMapHelp as IM
import Dodge.Item.Equipment
import qualified IntMapHelp as IM
flockArmourChaseCrit :: Creature
flockArmourChaseCrit =
defaultCreature
{ _crName = "armourChaseCrit"
, _crHP = HP 300
, _crInv = mempty
-- IM.fromList
-- [ --(0, frontArmour)
-- ]
, _crHP = 300
, _crInv =
IM.fromList
[ (0, frontArmour)
]
, _crActionPlan =
ActionPlan
{ _apImpulse = []
@@ -36,11 +36,11 @@ armourChaseCrit :: Creature
armourChaseCrit =
chaseCrit
{ _crName = "armourChaseCrit"
-- , --, _crUpdate = defaultImpulsive []
-- _crInv =
-- IM.fromList
-- [ --(0, frontArmour)
-- ]
, --, _crUpdate = defaultImpulsive []
_crInv =
IM.fromList
[ (0, frontArmour)
]
-- , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
}
-- & crEquipment . at OnChest ?~ 0
& crEquipment . at OnChest ?~ 0
src/Dodge/Creature/AutoCrit.hs
+4 -4
View File
@@ -2,18 +2,18 @@ module Dodge.Creature.AutoCrit (
autoCrit,
) where
--import Dodge.Item.Held.Cane
import Dodge.Item.Held.Cane
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
--import Picture
autoCrit :: Creature
autoCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, autoRifle)]
_crHP = HP 300
{ _crInv = IM.fromList [(0, autoRifle)]
, _crHP = 300
-- , _crMvType = defaultAimMvType
}
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/ChaseCrit.hs
+7 -7
View File
@@ -4,31 +4,31 @@ module Dodge.Creature.ChaseCrit (
chaseCrit,
) where
--import Dodge.Data.Equipment.Misc
--import Control.Lens
import Dodge.Data.Equipment.Misc
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
--import Dodge.Item.Equipment
import Dodge.Item.Equipment
import Picture
smallChaseCrit :: Creature
smallChaseCrit =
chaseCrit
{ _crHP = HP 1
{ _crHP = 1
, _crInv = mempty
}
invisibleChaseCrit :: Creature
invisibleChaseCrit =
chaseCrit
-- & crInv . at 0 ?~ wristInvisibility
-- & crEquipment . at OnLeftWrist ?~ 0
& crInv . at 0 ?~ wristInvisibility
& crEquipment . at OnLeftWrist ?~ 0
chaseCrit :: Creature
chaseCrit =
defaultCreature
{ _crName = "chaseCrit"
, _crHP = HP 150
, _crHP = 150
, _crInv = mempty
, _crFaction = ColorFaction green
, _crVocalization = chaseCritVocalization
src/Dodge/Creature/Damage.hs
+4 -5
View File
@@ -20,10 +20,9 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
_ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm w
| crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr
= f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
| otherwise = f . damageHP cr (_dmAmount dm) $ w
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
| otherwise = f . damageHP cr (_dmAmount dm)
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
/ V2 x x
@@ -33,5 +32,5 @@ applyPiercingDamage cr dm w
damageHP :: Creature -> Int -> World -> World
damageHP cr x =
(cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP -~ x)
(cWorld . lWorld . creatures . ix (_crID cr) . crHP -~ x)
. (cWorld . lWorld . creatures . ix (_crID cr) . crPain +~ x)
src/Dodge/Creature/HandPos.hs
+21 -25
View File
@@ -1,18 +1,19 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
equipSitePQ,
translatePointToLeftHand,
translatePointToRightHand,
translatePointToHead,
translateToLeftWrist,
translateToRightWrist,
translateToLeftLeg,
translateToRightLeg,
translateToHead,
translateToChest,
translateToLeftHand,
translateToRightHand,
backPQ,
headPQ,
translateToES,
) where
import Dodge.Data.Equipment.Misc
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
@@ -20,19 +21,6 @@ import Dodge.Data.Creature
import Geometry
import ShapePicture
translateToES :: Creature -> EquipSite -> Point3 -> Point3
translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
equipSitePQ :: EquipSite -> Creature -> Point3Q
equipSitePQ = \case
OnLeftWrist -> leftWristPQ
OnRightWrist -> rightWristPQ
OnHead -> headPQ
OnChest -> chestPQ
OnBack -> backPQ
OnLeftLeg -> leftLegPQ
OnRightLeg -> rightLegPQ
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
@@ -49,13 +37,14 @@ rightHandPQ cr
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
g i = negate 2 + negate 6 * (i) / sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
rightWristPQ :: Creature -> Point3Q
rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist cr = overPosSP
(\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
leftHandPQ :: Creature -> Point3Q
leftHandPQ cr
@@ -70,7 +59,7 @@ leftHandPQ cr
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
g i = negate 2 + negate 6 * ( i) / sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
@@ -78,8 +67,9 @@ translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
leftWristPQ :: Creature -> Point3Q
leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr = overPosSP
(\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
leftLegPQ :: Creature -> Point3Q
leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -112,18 +102,24 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: Creature -> SPic -> SPic
translateToHead cr = overPosSP (\p -> fst $ (headPQ cr `Q.comp` (p,Q.qID)))
headPQ :: Creature -> Point3Q
headPQ cr
| twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
| otherwise = (V3 2.5 0 20, Q.qID)
--translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
--translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
backPQ :: Creature -> Point3Q
backPQ cr
| oneH cr = (V3 0 0 10, Q.qz 0.5)
src/Dodge/Creature/Impulse.hs
+5 -6
View File
@@ -4,7 +4,6 @@ module Dodge.Creature.Impulse (
impulsiveAIBefore,
) where
import NewInt
import Dodge.Creature.MoveType
import Data.Foldable
import Control.Monad.State
@@ -43,8 +42,8 @@ followImpulse cr w imp = case imp of
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
Move p -> crup $ crMvBy p cr
MoveForward x -> crup $ crMvForward x cr
Turn a -> crup $ cr & crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
@@ -52,10 +51,10 @@ followImpulse cr w imp = case imp of
UseItem -> undefined
-- UseItem -> (useSelectedItem $ _crID cr
-- , cr)
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
Melee cid' ->
( hitCr cid'
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
)
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
@@ -72,7 +71,7 @@ followImpulse cr w imp = case imp of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvForward -> crup $ crMvForward speed cr
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
src/Dodge/Creature/Impulse/Movement.hs
+5 -6
View File
@@ -20,18 +20,17 @@ For now, though, this cannot fail.
crMvBy ::
-- | Movement translation vector, will be made relative to creature direction
Point2 ->
LWorld ->
Creature ->
Creature
crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
crMvAbsolute lw p' cr =
crMvAbsolute :: Point2 -> Creature -> Creature
crMvAbsolute p' cr =
advanceStepCounter (magV p) cr
& crPos +~ p
& crMvDir .~ argV p
where
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
p = strengthFactor (getCrMoveSpeed cr) *.* p'
strengthFactor :: Int -> Float
strengthFactor i
@@ -39,7 +38,7 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.02 * fromIntegral i
crMvForward :: Float -> LWorld -> Creature -> Creature
crMvForward :: Float -> Creature -> Creature
crMvForward speed = crMvBy (V2 speed 0)
advanceStepCounter :: Float -> Creature -> Creature
src/Dodge/Creature/Impulse/UseItem.hs
+35 -37
View File
@@ -2,7 +2,6 @@
module Dodge.Creature.Impulse.UseItem (useItem) where
import NewInt
import Control.Lens
import Data.Maybe
import Dodge.Data.ComposedItem
@@ -14,13 +13,12 @@ import Dodge.HeldUse
import Dodge.Inventory
import Dodge.Item.Grammar
import Dodge.Item.Location
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
useItem :: Int -> Int -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
itmloc <- invIndents (_crInv cr) ^? ix invid . _2
useItemLoc cr itmloc pt w
useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -45,8 +43,8 @@ useItemLoc cr loc pt w
return $ w & pointerToItem itm . itUse . useToggle .~ not b
| isJust $ itm ^? itType . ibtEquip
, pt == 0
, Just invid <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid cr w
, Just invid' <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid' cr w
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
where
aimuse
@@ -64,50 +62,50 @@ activateDetonator det = fromMaybe id $ do
pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
toggleEquipmentAt invid cr w = case equipmentDesignation invid w of
toggleEquipmentAt :: Int -> Creature -> World -> World
toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
DoNotMoveEquipment -> w
PutOnEquipment{_allocNewPos = newp} ->
w
& toequipment . at newp ?~ NInt itid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& effectOnEquip itm cr
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& onequip itm cr
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& toequipment . at newp ?~ NInt itid
& toequipment . at oldp .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
w
& toequipment . at newp ?~ NInt itid
& toequipment . at oldp ?~ sid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (_unNInt sid) . itLocation . ilEquipSite ?~ oldp
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
w
& toequipment . at newp ?~ NInt itid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (_unNInt rid) . itLocation . ilEquipSite .~ Nothing
& effectOnRemove (itmat rid) cr
& effectOnEquip itm cr
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
RemoveEquipment{_allocOldPos = oldp} ->
w
& toequipment . at oldp .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
& effectOnRemove itm cr
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
& onremove itm cr
where
toitems = cWorld . lWorld . items
itid = cr ^?! crInv . ix invid
toequipment = cWorld . lWorld . creatures . ix (_crID cr) . crEquipment
itmat i = w ^?! cWorld . lWorld . items . ix (_unNInt i)
itm = w ^?! cWorld . lWorld . items . ix itid
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat invid
onequip itm' = effectOnEquip itm'
onremove itm' = effectOnRemove itm'
toggleExamineInv :: World -> World
toggleExamineInv w = case w ^? hud . subInventory of
Just ExamineInventory{} -> w & hud . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ ExamineInventory
toggleExamineInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ ExamineInventory
toggleMapperInv :: Item -> World -> World
toggleMapperInv itm w = case w ^? hud . subInventory of
Just MapperInventory{} -> w & hud . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ MapperInventory 0 1 (_itID itm)
toggleMapperInv itm w = case w ^? hud . hudElement . subInventory of
Just MapperInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ MapperInventory 0 1 (_itID itm)
src/Dodge/Creature/Inanimate.hs
+5 -5
View File
@@ -11,22 +11,22 @@ module Dodge.Creature.Inanimate (
import Dodge.Creature.Lamp
import Dodge.Data.Creature
import Dodge.Default
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
--import LensHelp
barrel :: Creature
barrel =
defaultInanimate
{ _crHP = HP 500
{ _crHP = 500
, _crType = BarrelCrit PlainBarrel
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
explosiveBarrel :: Creature
explosiveBarrel =
defaultInanimate
{ _crHP = HP 400
{ _crHP = 400
, _crType = BarrelCrit (ExplosiveBarrel [])
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
-- & crMaterial .~ Crystal
src/Dodge/Creature/Lamp.hs
+1 -1
View File
@@ -13,7 +13,7 @@ colorLamp ::
Creature
colorLamp col h =
defaultInanimate
{ _crHP = HP 100
{ _crHP = 100
, _crType = LampCrit h col Nothing
-- , _crRad = 3
}
src/Dodge/Creature/LauncherCrit.hs
+4 -4
View File
@@ -2,18 +2,18 @@ module Dodge.Creature.LauncherCrit (
launcherCrit,
) where
--import Dodge.Item.Held.Launcher
import Dodge.Item.Held.Launcher
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
--import Picture
launcherCrit :: Creature
launcherCrit =
defaultCreature
{ -- _crInv = IM.fromList [(0, rLauncher)]
_crHP = HP 300
{ _crInv = IM.fromList [(0, rLauncher)]
, _crHP = 300
}
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ LauncherAI
src/Dodge/Creature/LtAutoCrit.hs
+4 -4
View File
@@ -5,15 +5,15 @@ module Dodge.Creature.LtAutoCrit (
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
--import Dodge.Item.Held.Stick
--import qualified IntMapHelp as IM
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Picture
ltAutoCrit :: Creature
ltAutoCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, autoPistol)]
_crHP = HP 500
{ _crInv = IM.fromList [(0, autoPistol)]
, _crHP = 500
}
-- & crType .~ LtAutoCrit
-- & crType . humanoidAI .~ LtAutoAI
src/Dodge/Creature/Picture.hs
+14 -8
View File
@@ -9,9 +9,7 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Shape
@@ -27,8 +25,8 @@ import Shape
--import Shape
import ShapePicture
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
basicCrPict :: Creature -> SPic
basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
@@ -92,7 +90,7 @@ deadRot cr = overPosSH (Q.rotateToZ d)
scalp :: Creature -> Shape
{-# INLINE scalp #-}
scalp cr = overPosSH (translateToES cr OnHead) fhead
scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
-- | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
-- | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
-- | otherwise = translateSHxy 2.5 0 fhead
@@ -101,7 +99,15 @@ scalp cr = overPosSH (translateToES cr OnHead) fhead
torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (translateToES cr OnBack) tsh
torso cr = overPosSH (\p -> fst $ (backPQ cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
---- mconcat
---- [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
---- , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
---- ]
-- | otherwise = tsh
where
tsh =
mconcat
@@ -124,6 +130,6 @@ upperBody cr = arms cr <> shoulderSH (torso cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: IM.IntMap Item -> Creature -> SPic
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
src/Dodge/Creature/PistolCrit.hs
+19
View File
@@ -0,0 +1,19 @@
module Dodge.Creature.PistolCrit (
pistolCrit,
) where
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Picture
pistolCrit :: Creature
pistolCrit =
defaultCreature
{ _crInv = IM.fromList [(0, pistol)]
, _crHP = 500
}
-- & crType . humanoidAI .~ PistolAI
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/SpreadGunCrit.hs
+4 -3
View File
@@ -5,14 +5,15 @@ module Dodge.Creature.SpreadGunCrit (
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
--import qualified IntMapHelp as IM
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Picture
spreadGunCrit :: Creature
spreadGunCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, bangStick 6)]
_crHP = HP 500
{ _crInv = IM.fromList [(0, bangStick 6)]
, _crHP = 500
}
-- & crType . humanoidAI .~ SpreadGunAI
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/State.hs
+27 -26
View File
@@ -4,7 +4,6 @@ module Dodge.Creature.State (
invItemEffs,
) where
import NewInt
import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M
@@ -54,7 +53,7 @@ applyPastDamages cr w
where
dojitter x y =
let (p, g) = runState (randInCirc x) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
& randGen .~ g
@@ -65,7 +64,7 @@ invItemEffs cid w = fromMaybe w $ do
return . appEndo (
foldMap
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
(invDT' $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) (_crInv cr))) $ w
(invDT' (_crInv cr))) $ w
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
@@ -78,7 +77,7 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF
, itm ^? itLocation . ilIsAttached == Just True -> shineTargetLaser cr loc w
HELD LED
HELD TORCH
| itm ^? itLocation . ilIsAttached == Just True -> shineTorch cr loc w
TARGETING tt
| itm ^? itLocation . ilIsAttached == Just True -> updateItemTargeting tt cr itm w
@@ -132,8 +131,8 @@ copierItemUpdate itm cr w = fromMaybe w $ do
x <- itm ^? itScroll . itsInt
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip (_unNInt invid) cr
itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
i <- getInventoryPath x ip invid cr
itm' <- cr ^? crInv . ix i
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
@@ -150,27 +149,27 @@ tryUseParent loc w = fromMaybe w $ do
tryDrawToCapacitor :: LocationDT OItem -> World -> World
tryDrawToCapacitor loc w = fromMaybe w $ do
itm <- loc ^? locDT . dtValue . _1
i <- itm ^? itID . unNInt
i <- itm ^? itLocation . ilInvID
x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
guard $ x < 200
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itID . unNInt
j <- bat ^? itLocation . ilInvID
y <- bat ^? itConsumables . _Just
let z = min y 10
return $ w
& invpoint . ix i . itConsumables . _Just +~ z
& invpoint . ix j . itConsumables . _Just -~ z
where
invpoint = cWorld . lWorld . items
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
trySynthBullet :: LocationDT OItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
i <- itm ^? itID . unNInt
i <- itm ^? itLocation . ilInvID
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itID . unNInt
j <- bat ^? itLocation . ilInvID
y <- bat ^. itConsumables
guard $ y > 0
return $ w
@@ -178,7 +177,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just -~ 1
else do
mag <- loc ^? locDtContext . cdtParent . _1
j <- mag ^? itID . unNInt
j <- mag ^? itLocation . ilInvID
y <- mag ^. itConsumables
ymax <- maxAmmo mag
guard $ y < ymax
@@ -187,7 +186,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just +~ 1
where
itm = loc ^. locDT . dtValue . _1
invpoint = cWorld . lWorld . items
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
drawARHUD :: LocationDT OItem -> World -> World
drawARHUD (LocDT con _) w = fromMaybe w $ do
@@ -203,12 +202,13 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ i >= x
magitid <- mag ^? dtValue . _1 . itID . unNInt
maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
return $
w
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld . items
. ix magitid
& cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix maginvid
. itConsumables
. _Just
-~ x
@@ -230,28 +230,28 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
pos = _crPos cr + xyV3 (rotate3 cdir p)
cdir = _crDir cr
itm = itmtree ^. dtValue . _1
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
shineTorch :: Creature -> LocationDT OItem -> World -> World
shineTorch cr loc = fromMaybe id $ do
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
-- guard $ crIsAiming cr
guard $ crIsAiming cr
guard $ i >= x
itid <- mag ^? dtValue . _1 . itID . unNInt
invid <- mag ^? dtValue . _1 . itLocation . ilInvID
return $
(cWorld . lWorld . lights .:~ LSParam pos 150 0.3)
. (cWorld . lWorld . lights .:~ LSParam (pos + V3 0 0 15) 50 0.3)
. (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
(cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locDT
(p, q) = locOrient loc cr
x = 10
isammolink AmmoMagSF{} = True
isammolink _ = False
pos = _crPos cr `v2z` 0 + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
pos = _crPos cr `v2z` 0 + rotate3 cdir (p + Q.rotate q (V3 8 0 1.5))
cdir = _crDir cr
-- this probably needs to be set to null when dropped as well?
@@ -281,8 +281,9 @@ updateItemTargeting tt cr itm w = case tt of
Nothing
True
where
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
src/Dodge/Creature/Statistics.hs
+14 -22
View File
@@ -6,15 +6,10 @@ module Dodge.Creature.Statistics (
crIntelligence,
) where
import Dodge.Data.Equipment.Misc
import qualified Data.Map.Strict as M
import NewInt
import Dodge.Data.LWorld
import Data.Maybe
--import qualified IntMapHelp as IM
import qualified Data.IntMap.Strict as IM
import Dodge.Data.Creature
import qualified IntMapHelp as IM
import LensHelp
import qualified Data.IntSet as IS
crDexterity :: Creature -> Int
crDexterity cr = case cr ^. crType of
@@ -47,11 +42,11 @@ crIntelligence cr = case cr ^. crType of
LampCrit {} -> 0
getCrMoveSpeed :: LWorld -> Creature -> Int
getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
getCrMoveSpeed :: Creature -> Int
getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
strFromEquipment :: LWorld -> Creature -> Int
strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
strFromEquipment :: Creature -> Int
strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
equipmentStrValue :: Item -> Int
equipmentStrValue itm = case _itType itm of
@@ -59,17 +54,14 @@ equipmentStrValue itm = case _itType itm of
EQUIP POWERLEGS -> 3
_ -> 0
crCurrentEquipment :: LWorld -> Creature -> M.Map EquipSite Item
crCurrentEquipment lw = fmap f . _crEquipment
where
f i = lw ^?! items . ix (_unNInt i)
crCurrentEquipment :: Creature -> IM.IntMap Item
crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
strFromHeldItem :: LWorld -> Creature -> Int
strFromHeldItem lw cr = fromMaybe 0 $ do
Aiming {} <- cr ^? crStance . posture
is <- cr ^? crManipulation . manObject . imAttachedItems
let js = IM.elems $ IM.restrictKeys (cr ^. crInv . unNIntMap) is
return . negate . sum . fmap itemWeight $ IM.restrictKeys (lw ^. items) $ IS.fromList js
strFromHeldItem :: Creature -> Int
strFromHeldItem cr = fromMaybe 0 $ do
Aiming <- cr ^? crStance . posture
i <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap (negate . itemWeight) $ cr ^? crInv . ix i
itemWeight :: Item -> Int
itemWeight it = case it ^. itType of
@@ -114,7 +106,7 @@ heldItemWeight = \case
GLAUNCHER -> 10
POISONSPRAYER -> 10
SHATTERGUN -> 10
LED -> 5
TORCH -> 5
FLATSHIELD -> 15
KEYCARD {} -> 5
BLINKER -> 5
src/Dodge/Creature/SwarmCrit.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Picture
swarmCrit :: Creature
swarmCrit =
defaultCreature
{ _crHP = HP 1
{ _crHP = 1
-- , _crRad = 2
, _crFaction = ColorFaction yellow
}
src/Dodge/Creature/Test.hs
+21 -7
View File
@@ -24,11 +24,11 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import NewInt
import qualified Data.IntMap.Strict as IM
import Dodge.Item.Grammar
import Dodge.Creature.Radius
import Dodge.Data.Equipment.Misc
import Dodge.Data.AimStance
import Dodge.Item.AimStance
import Control.Lens
import Data.List (find)
import Data.Maybe
@@ -87,8 +87,18 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
sentinelGoal (SentinelAt _ _) = True
sentinelGoal _ = False
--crCanShoot :: Creature -> Bool
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as
crInAimStance as cr = crIsAiming cr && mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
return $ aimStance itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
oneH = crInAimStance OneHand
@@ -102,16 +112,20 @@ twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
-- Not sure if it is a good idea
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
crIsArmouredFrom m p cr = fromMaybe False $ do
NInt itid <- cr ^? crEquipment . ix OnChest
ittype <- m ^? ix itid . itType
crIsArmouredFrom :: Point2 -> Creature -> Bool
crIsArmouredFrom = hasFrontArmour
hasFrontArmour :: Point2 -> Creature -> Bool
hasFrontArmour p cr = fromMaybe False $ do
invid <- cr ^? crEquipment . ix OnChest
ittype <- cr ^? crInv . ix invid . itType
return $
EQUIP FRONTARMOUR == ittype
&& p /= _crOldPos cr
&& angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
where
-- even though angleVV can generate NaN, the comparison seems to deal with it
frontarmdirection
| crInAimStance OneHand cr = 0.5
| crInAimStance TwoHandUnder cr = negate 1
src/Dodge/Creature/Update.hs
+31 -41
View File
@@ -1,11 +1,10 @@
module Dodge.Creature.Update (updateCreature) where
import NewInt
import Color
import qualified Data.IntMap.Strict as IM
import qualified Data.List as List
import Dodge.Barreloid
--import Dodge.Base.NewID
import Dodge.Base.NewID
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Radius
@@ -30,8 +29,7 @@ import ShapePicture.Data
-- allow for knockbacks etc to be determined as well as intended movements
updateCreature :: Creature -> World -> World
updateCreature cr
| null (cr ^? crHP . _HP) = id
| _crZ cr < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
| _crZ cr < negate 100 = (tocr . crHP .~ negate 1) . destroyAllInvItems cr
| _crZ cr < 0 = (tocr . crZVel -~ 0.5) . (tocr . crZ +~ _crZVel cr)
| otherwise = updateCreature' cr
where
@@ -63,59 +61,51 @@ crUpdate' f cr =
. g
. updateWalkCycle cid
where
cid = cr ^. crID
cid = (cr ^. crID)
g w' = maybe id f (w' ^? cWorld . lWorld . creatures . ix cid) w'
checkDeath :: Int -> World -> World
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
checkDeath' :: Creature -> World -> World
checkDeath' cr w = case cr ^. crHP of
HP x | x > 0 -> w & tocr . crDamage .~ []
HP x | x > -200 && _crDeathTimer cr < 5 -> w
& tocr . crDamage .~ []
& tocr . crDeathTimer +~ 1
HP x | x > -200 -> w
checkDeath' cr w
| _crHP cr > 0 = w & tocr . crDamage .~ []
| _crHP cr <= -200 = w
& dropAll cr -- the order of
-- & removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
HP _ -> w
& dropAll cr -- the order of
& tocr . crHP .~ CrIsGibs
-- & destroyCreature cr -- these is important
& destroyCreature cr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
_ -> w
-- | otherwise = w
-- & dropAll cr -- the order of
-- & removecr -- these is important
-- & stopSoundFrom (CrWeaponSound (_crID cr) 0)
-- & corpseOrGib cr
| _crHP cr > -200 && _crDeathTimer cr < 5 = w
& tocr . crDamage .~ []
& tocr . crDeathTimer +~ 1
| otherwise = w
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
-- removecr
-- | _crID cr == 0 = id
-- -- hack to get around player creature being killed but left with more than 0 hp
-- | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
removecr
| _crID cr == 0 = id
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
--destroyCreature :: Creature -> World -> World
--destroyCreature cr
-- | _crID cr == 0 = id
-- -- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- -- hack to get around player creature being killed but left with more than 0 hp
-- | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
destroyCreature :: Creature -> World -> World
destroyCreature cr
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> sethp (CrIsCorpse $ scorchSPic thecorpse)
Just PoisonDamage -> sethp (CrIsCorpse $ poisonSPic thecorpse)
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
. sethp CrIsGibs
_ -> sethp (CrIsCorpse thecorpse)
_ -> addcorpse thecorpse
where
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
@@ -126,7 +116,7 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
-- reverse keys, otherwise two or more inv items will cause errors
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
chasmTest :: Creature -> World -> World
chasmTest cr w
src/Dodge/Creature/Volition.hs
+1 -2
View File
@@ -6,7 +6,6 @@ module Dodge.Creature.Volition (
shootFirstMiss,
) where
import Dodge.Data.AimStance
import Dodge.Data.Creature
import Dodge.Data.CreatureEffect
import Dodge.SoundLogic.LoadSound
@@ -14,7 +13,7 @@ import Geometry
holsterWeapon, drawWeapon :: Action
holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
drawWeapon = DoImpulses [ChangePosture $ Aiming OneHand, MakeSound whiteNoiseFadeInS]
drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
shootTillEmpty :: Action
--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
src/Dodge/Creature/YourControl.hs
+45 -61
View File
@@ -1,18 +1,19 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.YourControl (yourControl) where
module Dodge.Creature.YourControl (
yourControl,
) where
import Dodge.Creature.MoveType
import Dodge.Data.Equipment.Misc
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.AssignHotkey
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.MoveType
import Dodge.Data.AimStance
import Dodge.Data.Equipment.Misc
import Dodge.Data.World
import Dodge.AssignHotkey
import Dodge.InputFocus
import Dodge.Inventory
import Dodge.Item.AimStance
@@ -27,59 +28,52 @@ import qualified SDL
yourControl :: Creature -> World -> World
yourControl _ w
| inTextInputFocus w = w
| Just x <- w ^? hud . subInventory
| Just x <- w ^? hud . hudElement . subInventory
, f x =
w
& cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
& tryClickUse pkeys
& handleHotkeys
| otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
| otherwise =
w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
where
f = \case
NoSubInventory -> True
ExamineInventory -> True
_ -> False
f NoSubInventory = True
f ExamineInventory = True
f _ = False
pkeys = w ^. input . mouseButtons
-- the following only works because modifier keys are ordered after scancode "hotkeys"
handleHotkeys :: World -> World
handleHotkeys w
| ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
, (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
w & cWorld . lWorld %~ assignHotkey itid hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
, (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $
w ^. input . pressedKeys
, Just itid <- lw ^? hotkeys . ix hk . unNInt
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
w & invSetSelectionPos 0 (_unNInt invid)
, Just invid <- lw ^? itemLocations . ix itid . ilInvID =
w & invSetSelectionPos 0 invid
| otherwise =
M.foldl'
useHotkey
w
(M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
where
pkeys = w ^. input . pressedKeys
ispressed k = k `M.member` _pressedKeys (_input w)
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
lw = w ^. cWorld . lWorld
--modifierKeys :: S.Set SDL.Scancode
--modifierKeys = S.fromList
-- [ SDL.ScancodeLShift
-- , SDL.ScancodeRShift
-- , SDL.ScancodeRCtrl
-- , SDL.ScancodeLCtrl
-- ]
useHotkey :: World -> (NewInt ItmInt, Int) -> World
useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
useItem invid pt w
hotkeyToScancode :: Hotkey -> SDL.Scancode
hotkeyToScancode = \case
hotkeyToScancode x = case x of
HotkeyQ -> SDL.ScancodeQ
HotkeyE -> SDL.ScancodeE
HotkeyR -> SDL.ScancodeE
@@ -99,7 +93,7 @@ hotkeyToScancode = \case
Hotkey0 -> SDL.Scancode0
scancodeToHotkey :: SDL.Scancode -> Maybe Hotkey
scancodeToHotkey = \case
scancodeToHotkey x = case x of
SDL.ScancodeQ -> Just HotkeyQ
SDL.ScancodeE -> Just HotkeyE
SDL.ScancodeR -> Just HotkeyR
@@ -123,7 +117,7 @@ scancodeToHotkey = \case
within wasdMovement should probably be done first
-}
wasdWithAiming :: World -> Creature -> Creature
wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
where
speed = _mvSpeed $ crMvType cr
inp = w ^. input
@@ -133,40 +127,31 @@ wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr
| Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
, Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
setAimPosture (w ^. cWorld . lWorld . items) cr
| SDL.ButtonRight `M.member` _mouseButtons inp =
aimTurn (w ^. cWorld . lWorld) mousedir cr
| Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
setAimPosture cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture cr
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
where
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
setAimPosture :: IM.IntMap Item -> Creature -> Creature
setAimPosture m cr = fromMaybe cr $ do
invid <- cr ^? crManipulation . manObject . imRootSelectedItem
itid <- cr ^? crInv . ix invid
as <- fmap itemBaseStance $ m ^? ix itid
return $ cr
& crStance . posture .~ Aiming as
& doAimTwist as (- twoHandTwistAmount)
setAimPosture :: Creature -> Creature
setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
doAimTwist :: AimStance -> Float -> Creature -> Creature
doAimTwist as x
| as == TwoHandOver || as == TwoHandUnder = crDir +~ x
| otherwise = id
doAimTwist :: Float -> Creature -> Creature
doAimTwist x cr = fromMaybe cr $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
guard $ astance == TwoHandOver || astance == TwoHandUnder
return $ cr & crDir +~ x
removeAimPosture :: Creature -> Creature
removeAimPosture cr = fromMaybe cr $ do
as <- cr ^? crStance . posture . aimStance
return $ cr
& crStance . posture .~ AtEase
& doAimTwist as twoHandTwistAmount
removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
twoHandTwistAmount :: Float
twoHandTwistAmount = 1.6 * pi
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement lw inp cam speed = theMovement . setMvAim
wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
wasdMovement inp cam speed = theMovement . setMvAim
where
setMvAim = fromMaybe id $ do
dir <- safeArgV movDir
@@ -175,14 +160,14 @@ wasdMovement lw inp cam speed = theMovement . setMvAim
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute lw (speed *.* movAbs)
| otherwise = crMvAbsolute (speed *.* movAbs)
aimTurn :: LWorld -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
itemBulkiness :: ItemType -> Float
itemBulkiness = \case
@@ -227,7 +212,7 @@ heldItemBulkiness = \case
GLAUNCHER -> 1
POISONSPRAYER -> 1
SHATTERGUN -> 1
LED -> 1
TORCH -> 1
FLATSHIELD -> 0.5
KEYCARD{} -> 1
BLINKER -> 1
@@ -242,7 +227,6 @@ tryClickUse pkeys w = fromMaybe w $ do
^? cWorld . lWorld . creatures . ix 0
. crManipulation
. manObject
. imSelectedItem
. unNInt of
. imSelectedItem of
Just invid -> useItem invid ltime w
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
src/Dodge/Data/AimStance.hs
-9
View File
@@ -1,12 +1,6 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.AimStance where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
data AimStance
= TwoHandUnder
@@ -14,6 +8,3 @@ data AimStance
| TwoHandFlat
| OneHand
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''AimStance
deriveJSON defaultOptions ''AimStance
src/Dodge/Data/Button.hs
+2 -1
View File
@@ -25,13 +25,14 @@ data ButtonEvent
, _bsColor2 :: Color
, _btOn :: Bool
}
| ButtonAccessTerminal {_btTermID :: Int}
| ButtonAccessTerminal
data Button = Button
{ _btPos :: Point2
, _btRot :: Float
, _btEvent :: ButtonEvent
, _btID :: Int
, _btTermMID :: Maybe Int
}
makeLenses ''Button
src/Dodge/Data/CardinalPoint.hs
-14
View File
@@ -1,6 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CardinalPoint where
import Control.Lens
data CardinalPoint
= North
@@ -9,13 +7,6 @@ data CardinalPoint
| West
deriving (Eq, Ord, Show, Bounded, Enum)
data CardinalPointBetween
= NorthEast
| SouthEast
| SouthWest
| NorthWest
deriving (Eq, Ord, Show, Bounded, Enum)
data CardinalEightPoint
= North8
| NorthEast8
@@ -32,8 +23,3 @@ data CardinalCover
| NSE
| NSW
| NS
data XInfinity a = NegInf | NonInf {_nonInf :: a} | PosInf
deriving (Eq, Ord, Show)
makeLenses ''XInfinity
src/Dodge/Data/Combine.hs
+2 -6
View File
@@ -1,13 +1,9 @@
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Combine where
import Control.Lens
import Dodge.Data.Item
data CombItem = CombItem
data CombinableItem = CombinableItem
{ _ciInvIDs :: [Int]
, _ciItem :: Item
}
makeLenses ''CombItem
makeLenses ''CombinableItem
src/Dodge/Data/Config.hs
+30 -30
View File
@@ -12,30 +12,30 @@ import qualified Data.Set as S
{-# ANN module "HLint: ignore Use camelCase" #-}
data NumShadowCasters
= NumLight0
| NumLight1
| NumLight2
| NumLight3
| NumLight4
| NumLight5
| NumLight6
| NumLight7
| NumLight8
| NumLight9
| NumLight10
| NumLight11
| NumLight12
| NumLight13
| NumLight14
| NumLight15
| NumLight16
| NumLight17
| NumLight18
| NumLight19
| NumLight20
= NumShadowCasters0
| NumShadowCasters1
| NumShadowCasters2
| NumShadowCasters3
| NumShadowCasters4
| NumShadowCasters5
| NumShadowCasters6
| NumShadowCasters7
| NumShadowCasters8
| NumShadowCasters9
| NumShadowCasters10
| NumShadowCasters11
| NumShadowCasters12
| NumShadowCasters13
| NumShadowCasters14
| NumShadowCasters15
| NumShadowCasters16
| NumShadowCasters17
| NumShadowCasters18
| NumShadowCasters19
| NumShadowCasters20
deriving (Show,Eq,Bounded,Ord,Enum)
data Config = Config
data Configuration = Configuration
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
@@ -58,9 +58,9 @@ data Config = Config
}
deriving (Show)
windowXFloat :: Config -> Float
windowXFloat :: Configuration -> Float
windowXFloat = fromIntegral . _windowX
windowYFloat :: Config -> Float
windowYFloat :: Configuration -> Float
windowYFloat = fromIntegral . _windowY
data DebugBool
@@ -88,8 +88,8 @@ data DebugBool
| Show_walls_near_point_you
| Show_walls_near_segment
| Show_zone_near_point_cursor
| Show_zone_circ
| Inspect_wall
| Show_nodes_near_select
| Show_path_between
| Select_creature
deriving (Eq, Ord, Bounded, Enum, Show)
@@ -124,9 +124,9 @@ applyResFactor rf = case rf of
-- EighthRes -> 8
-- SixteenthRes -> 16
defaultConfig :: Config
defaultConfig :: Configuration
defaultConfig =
Config
Configuration
{ _volume_master = 1
, _volume_sound = 1
, _volume_music = 0
@@ -148,13 +148,13 @@ defaultConfig =
, _debug_view_clip_bounds = NoRoomClipBoundaries
}
debugOn :: DebugBool -> Config -> Bool
debugOn :: DebugBool -> Configuration -> Bool
debugOn db = S.member db . _debug_booleans
makeLenses ''Config
makeLenses ''Configuration
deriveJSON defaultOptions ''NumShadowCasters
deriveJSON defaultOptions ''ResFactor
deriveJSON defaultOptions ''ShadowRendering
deriveJSON defaultOptions ''RoomClipping
deriveJSON defaultOptions ''DebugBool
deriveJSON defaultOptions ''Config
deriveJSON defaultOptions ''Configuration
src/Dodge/Data/Corpse.hs
+28
View File
@@ -0,0 +1,28 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Corpse where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
import ShapePicture.Data
data CorpseResurrection = NoResurrection
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
, _cpDir :: Float
, _cpSPic :: SPic
, _cpRes :: CorpseResurrection
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Corpse
deriveJSON defaultOptions ''CorpseResurrection
deriveJSON defaultOptions ''Corpse
src/Dodge/Data/Creature.hs
+4 -14
View File
@@ -17,8 +17,6 @@ module Dodge.Data.Creature (
module Dodge.Data.Item.Use.Consumption.LoadAction,
) where
import ShapePicture.Data
import NewInt
import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.Equipment.Misc
import Control.Lens
@@ -34,7 +32,7 @@ import Dodge.Data.Creature.State
import Dodge.Data.Item
import Dodge.Data.Material
import Geometry.Data
--import qualified IntMapHelp as IM
import qualified IntMapHelp as IM
data Creature = Creature
{ _crPos :: Point2
@@ -46,10 +44,10 @@ data Creature = Creature
, _crMvAim :: Float
, _crType :: CreatureType
, _crID :: Int
, _crHP :: CrHP
, _crInv :: NewIntMap InvInt Int
, _crHP :: Int
, _crInv :: IM.IntMap Item
, _crManipulation :: Manipulation
, _crEquipment :: M.Map EquipSite (NewInt ItmInt)
, _crEquipment :: M.Map EquipSite Int
, _crDamage :: [Damage]
, _crPain :: Int
, _crStance :: Stance
@@ -67,12 +65,6 @@ data Creature = Creature
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrHP
= HP Int
| CrIsCorpse SPic
| CrIsGibs
| CrIsPitted
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
@@ -83,12 +75,10 @@ data Intention = Intention
makeLenses ''Creature
makeLenses ''Intention
makePrisms ''CrHP
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''Creature
, ''Intention
, ''CrHP
]
src/Dodge/Data/Creature/Stance.hs
+2 -6
View File
@@ -3,12 +3,8 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Creature.Stance
( module Dodge.Data.Creature.Stance
, module Dodge.Data.AimStance
)where
module Dodge.Data.Creature.Stance where
import Dodge.Data.AimStance
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -36,7 +32,7 @@ data FootForward = LeftForward | RightForward
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Posture
= Aiming {_aimStance :: AimStance}
= Aiming
| AtEase
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Data/EquipType.hs
+3 -3
View File
@@ -22,9 +22,9 @@ eitType = \case
BRAINHAT -> GoesOnHead
HAT -> GoesOnHead
HEADLAMP -> GoesOnHead
POWERLEGS -> GoesOnLeg
SPEEDLEGS -> GoesOnLeg
JUMPLEGS -> GoesOnLeg
POWERLEGS -> GoesOnLegs
SPEEDLEGS -> GoesOnLegs
JUMPLEGS -> GoesOnLegs
FUELPACK -> GoesOnBack
BULLETBELTPACK -> GoesOnBack
BULLETBELTBRACER -> GoesOnWrist
src/Dodge/Data/Equipment/Misc.hs
+3 -4
View File
@@ -13,7 +13,7 @@ data EquipType
| GoesOnChest
| GoesOnBack
| GoesOnWrist
| GoesOnLeg
| GoesOnLegs
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -24,9 +24,8 @@ data EquipSite
| OnBack
| OnLeftWrist
| OnRightWrist
| OnLeftLeg
| OnRightLeg
-- | OnSpecial
| OnLegs
| OnSpecial
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Data/FloorItem.hs
+3 -2
View File
@@ -5,14 +5,15 @@
module Dodge.Data.FloorItem where
import NewInt
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
--import Dodge.Data.Item
import Dodge.Data.Item
import Geometry.Data
data FloorItem = FlIt {_flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: NewInt FloorInt}
--deriving (Eq, Show, Read) --Generic, Flat)
makeLenses ''FloorItem
src/Dodge/Data/GenParams.hs
+1 -1
View File
@@ -5,7 +5,7 @@
module Dodge.Data.GenParams where
import Dodge.Data.Machine.Sensor
import Dodge.Data.Machine.Sensor.Type
import Color
import Control.Lens
import Data.Aeson
src/Dodge/Data/GenWorld.hs
+27 -46
View File
@@ -8,7 +8,6 @@ module Dodge.Data.GenWorld (
module Dodge.Data.World,
) where
import ShortShow
import Color
import Control.Lens
import Control.Monad.State
@@ -23,20 +22,14 @@ import System.Random
data GenWorld = GenWorld
{ _gwWorld :: World
, _genPlacements :: IM.IntMap [(Placement, Int)]
, _genRooms :: IM.IntMap Room
, _genPmnt :: IM.IntMap Placement
, _genInts :: IM.IntMap Int
}
---- ROOM DATATYPES
data PSType
= PutCrit {_unPutCrit :: Creature}
| PutMachine
{ _putMachinePoly :: [Point2]
, _putMachineMachine :: Machine
, _putMachineWall :: Wall
, _putMachineMaybeItem :: Maybe Item
}
| PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
| PutLS LightSource
| PutButton {_putButton :: Button}
| PutProp Prop
@@ -58,38 +51,11 @@ data PSType
| PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
| PutWorldUpdate (PlacementSpot -> World -> World)
| PutNothing
| PutUsingGenParams (World -> (World, PSType))
| PutID {_putID :: Int}
| PutChasm {_putChasmPoly :: [Point2]}
| PutLabel {_putLabel :: String} -- currently not actually put anywhere
-- just used for later inspection as top level
-- of a continuing placement in a room placement list
instance ShortShow PSType where
shortShow PutCrit {} = "PutCrit"
shortShow PutMachine {} = "PutMachine"
shortShow PutLS {} = "PutLS"
shortShow PutButton {} = "PutButton"
shortShow PutProp {} = "PutProp"
shortShow PutTerminal {} = "PutTerminal"
shortShow PutFlIt {} = "PutFlIt"
shortShow PutPPlate {} = "PutPPlate"
shortShow PutBlock {} = "PutBlock"
shortShow PutCoord {} = "PutCoord"
shortShow PutMod {} = "PutMod"
shortShow PutTrigger {} = "PutTrigger"
shortShow PutLineBlock {} = "PutLineBlock"
shortShow PutWall {} = "PutWall"
shortShow PutSlideDr {} = "PutSlideDr"
shortShow PutDoor {} = "PutDoor"
shortShow RandPS {} = "RandPS"
shortShow PutForeground {} = "PutForeground"
shortShow PutWorldUpdate {} = "PutWorldUpdate"
shortShow PutNothing = "PutNothing"
shortShow PutID {} = "PutID"
shortShow PutChasm {} = "PutChasm"
shortShow PutLabel {} = "PutLabel"
-- maybe there is a monadic implementation of this?
-- add room effect for any placement spot?
@@ -107,13 +73,17 @@ data PlacementSpot
}
-- TODO attempt to unify/simplify this union type
data Placement = Placement
{ _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plExternalID :: Maybe Int
, _plIDCont :: GenWorld -> Placement -> Maybe Placement
}
data Placement
= Placement
{ _plOrder :: Int
, _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
}
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
| PickOnePlacement Int Placement
{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
@@ -136,7 +106,8 @@ data Room = Room
, _rmPos :: [RoomPos]
, _rmPath :: S.Set (Point2, Point2)
, _rmPmnts :: [Placement]
, _rmInPmnt :: [(Int,GenWorld -> Placement)]
, _rmInPmnt :: [InPlacement]
, _rmOutPmnt :: [OutPlacement]
, _rmBound :: [[Point2]]
, _rmFloor :: Floor
, _rmName :: String
@@ -153,6 +124,16 @@ data Room = Room
, _rmClusterStatus :: ClusterStatus
}
data OutPlacement = OutPlacement
{ _opPlacement :: Placement
, _opPlacementID :: Int
}
data InPlacement = InPlacement
{ _ipPlacement :: [Placement] -> Placement
, _ipPlacementID :: Int
}
makeLenses ''GenWorld
makeLenses ''Room
makeLenses ''RoomType
src/Dodge/Data/HUD.hs
+26 -16
View File
@@ -5,41 +5,51 @@
module Dodge.Data.HUD where
import Control.Lens
import qualified Data.IntSet as IS
import Dodge.Data.Combine
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
import Data.IntMap
import Data.IntSet (IntSet)
import Dodge.Data.Combine
import Dodge.Data.SelectionList
import Geometry.Data
import NewInt
data HUDElement
= DisplayInventory
{ _subInventory :: SubInventory
, _diSections :: IMSS ()
, _diSelection :: Maybe (Int, Int, IntSet)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
}
-- | DisplayCarte
data SubInventory
= NoSubInventory
| ExamineInventory
| MapperInventory
{ _mapInvOffset :: Point2
| MapperInventory
{_mapInvOffset :: Point2
, _mapInvZoom :: Float
, _mapInvItmID :: NewInt ItmInt
}
| CombineInventory
{ _ciSections :: IMSS CombItem
, _ciSelection :: Maybe Selection
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int, IS.IntSet)
, _ciFilter :: Maybe String
}
-- | LockedInventory
| DisplayTerminal {_termID :: Int}
data HUD = HUD
{ _subInventory :: SubInventory
, _diSections :: IMSS ()
, _diSelection :: Maybe Selection
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _closeItems :: [NewInt ItmInt]
{ _hudElement :: HUDElement
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
, _closeItems :: [NewInt FloorInt]
, _closeButtons :: [Int]
}
data Selection = Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
makeLenses ''HUD
makeLenses ''Selection
makeLenses ''HUDElement
makeLenses ''SubInventory
src/Dodge/Data/Input.hs
+8 -5
View File
@@ -5,7 +5,6 @@
module Dodge.Data.Input where
import Dodge.Data.Terminal.Status
import Control.Lens
import qualified Data.Map.Strict as M
import Geometry.Data
@@ -17,16 +16,20 @@ data MouseContext
| MouseInGame
| MouseMenuClick {_mcoMenuClick :: Int}
| MouseMenuCursor
| OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
| OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
| OverInvDrag {_mcoDragSection :: Int
, _mcoMaybeSelect :: Maybe (Int,Int)
, _mcoAboveSelect :: Maybe (Int,Int)
, _mcoBelowSelect :: Maybe (Int,Int)
}
| OverInvDragSelect { _mcoSecSelStart :: (Int,Int), _mcoSelEnd :: Maybe Int }
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverCombFiltInv { _mcoInvFilt :: (Int,Int)}
| OverCombSelect { _mcoCombSelect :: (Int,Int)}
| OverCombCombine { _mcoCombCombine :: (Int,Int)}
| OverCombFilter
| OverCombEscape
| OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
| OutsideTerminal
| OverTerminalReturn {_mcoTermID :: Int}
| OverTerminalEscape
| MouseGameRotate
deriving (Show)
src/Dodge/Data/Item.hs
+22 -7
View File
@@ -3,6 +3,7 @@
module Dodge.Data.Item (
module Dodge.Data.Item,
--module Dodge.Data.Item.Effect,
module Dodge.Data.Item.Misc,
module Dodge.Data.Item.Params,
module Dodge.Data.Item.Use,
@@ -11,18 +12,30 @@ module Dodge.Data.Item (
module Dodge.Data.Item.Location,
) where
import Geometry.Data
--import qualified Data.IntMap.Strict as IM
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Combine
--import Dodge.Data.Item.Effect
import Dodge.Data.Item.Location
import Dodge.Data.Item.Misc
import Dodge.Data.Item.Params
import Dodge.Data.Item.Scope
import Dodge.Data.Item.Use
import Geometry.Data
import NewInt
data ItID = ItID
deriving (Eq, Ord, Show, Read)
--data Consumables
-- = NoConsumables
-- | AmmoMag
-- { _magLoadStatus :: ReloadStatus
-- }
-- deriving (Eq, Show, Read)
data Item = Item
{ _itUse :: ItemUse
, _itConsumables :: Maybe Int
@@ -40,17 +53,19 @@ data ItemScroll
| ItemScrollInt {_itsInt :: Int}
| ItemScrollIntRange {_itsMax :: Int, _itsRangeInt :: Int}
data ItemTargeting
= NoItTargeting
data ItemTargeting = NoItTargeting
| ItTargeting
{ _itTgPos :: Maybe Point2
, _itTgID :: Maybe Int
, _itTgActive :: Bool
}
{ _itTgPos :: Maybe Point2
, _itTgID :: Maybe Int
, _itTgActive :: Bool
}
makeLenses ''ItemTargeting
--makeLenses ''Consumables
makeLenses ''Item
makeLenses ''ItemScroll
deriveJSON defaultOptions ''ItemScroll
--deriveJSON defaultOptions ''Consumables
deriveJSON defaultOptions ''ItemTargeting
deriveJSON defaultOptions ''ItID
deriveJSON defaultOptions ''Item
src/Dodge/Data/Item/Combine.hs
+2 -1
View File
@@ -75,6 +75,7 @@ data CraftType
| AIUNIT
| CAMERA
| MINIDISPLAY -- visual display unit
| LED
| NAILBOX
| IRONBAR
| LIGHTSENSOR
@@ -172,7 +173,7 @@ data HeldItemType
| GLAUNCHER
| POISONSPRAYER
| SHATTERGUN
| LED
| TORCH
| FLATSHIELD
| KEYCARD Int
| BLINKER
src/Dodge/Data/Item/Location.hs
+7 -14
View File
@@ -5,15 +5,17 @@
{-# LANGUAGE EmptyDataDeriving #-}
module Dodge.Data.Item.Location where
import NewInt
import ShortShow
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import NewInt
-- it would be nice to have these as empty types, but I'm not sure how to get
-- aeson to handle that
data FloorInt = FloorInt
deriving (Eq,Ord,Show,Read)
-- should use these..
data InvInt = InvInt
deriving (Eq,Ord,Show,Read)
data TurretInt
@@ -26,29 +28,20 @@ data ItmInt = ItmInt
data ItemLocation
= InInv
{ _ilCrID :: Int
, _ilInvID :: NewInt InvInt
, _ilInvID :: Int
, _ilIsRoot :: Bool -- of any item
, _ilIsSelected :: Bool
, _ilIsAttached :: Bool -- to selected item
, _ilEquipSite :: Maybe EquipSite
}
| OnTurret {_ilTuID :: Int}
| OnFloor-- {_ilFlID :: NewInt FloorInt}
| OnFloor {_ilFlID :: NewInt FloorInt}
| InVoid
deriving (Eq, Show, Ord, Read) --Generic, Flat)
instance ShortShow ItemLocation where
shortShow (InInv cid invid rootb selb attb esite)
= "InInv:cid" <> shortShow cid <> "invid"<> shortShow (_unNInt invid)
<>"root"<>shortShow rootb<>"sel"<>shortShow selb<>"att"<>shortShow attb<>
shortShow (fmap (SString . show) esite)
shortShow x = show x
-- | OnTurret {_ilTuID :: Int}
-- | OnFloor-- {_ilFlID :: NewInt FloorInt}
-- | InVoid
makeLenses ''ItemLocation
deriveJSON defaultOptions ''InvInt
deriveJSON defaultOptions ''FloorInt
deriveJSON defaultOptions ''ItemLocation
deriveJSON defaultOptions ''ItmInt
deriveJSON defaultOptions ''CrInt
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+3 -5
View File
@@ -5,8 +5,6 @@
module Dodge.Data.Item.Use.Consumption.LoadAction where
import Dodge.Data.Item.Location
import NewInt
import qualified Data.IntSet as IS
import Control.Lens
import Data.Aeson
@@ -22,9 +20,9 @@ data Manipulation -- should be ManipulatedObject?
data ManipulatedObject
= SortInventory
| SelectedItem
{ _imSelectedItem :: NewInt InvInt
, _imRootSelectedItem :: NewInt InvInt
, _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
{ _imSelectedItem :: Int
, _imRootSelectedItem :: Int
, _imAttachedItems :: IS.IntSet
}
| SelNothing
| SortCloseItem
src/Dodge/Data/LWorld.hs
+7 -3
View File
@@ -11,6 +11,7 @@ module Dodge.Data.LWorld (
module Dodge.Data.Bullet,
module Dodge.Data.Button,
module Dodge.Data.Cloud,
module Dodge.Data.Corpse,
module Dodge.Data.CrGroupParams,
module Dodge.Data.Creature,
module Dodge.Data.Damage,
@@ -59,6 +60,7 @@ import Dodge.Data.Bounds
import Dodge.Data.Bullet
import Dodge.Data.Button
import Dodge.Data.Cloud
import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.Creature
import Dodge.Data.Damage
@@ -97,7 +99,7 @@ import Picture.Data
data LWorld = LWorld
{ _creatures :: IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _items :: IM.IntMap Item
, _itemLocations :: IM.IntMap ItemLocation
, _clouds :: [Cloud]
, _dusts :: [Dust]
, _gusts :: IM.IntMap Gust
@@ -127,14 +129,16 @@ data LWorld = LWorld
, _oldMagnets :: [Magnet]
, _magnets :: [Magnet]
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap Bool
, _floorItems :: IM.IntMap FloorItem
, _floorItems :: NewIntMap FloorInt FloorItem
, _modifications :: IM.IntMap Modification
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _foreShapes :: IM.IntMap ForegroundShape
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _lightSources :: IM.IntMap LightSource
, _lights :: [LSParam]
, _seenLocations :: IM.IntMap (WdP2, String)
src/Dodge/Data/MTRS.hs
-6
View File
@@ -1,6 +0,0 @@
module Dodge.Data.MTRS where
import Dodge.Data.GenWorld
import Dodge.Data.MetaTree
type MTRS = MetaTree Room String
src/Dodge/Data/Machine.hs
+11 -3
View File
@@ -26,6 +26,7 @@ import Dodge.Data.Machine.Sensor
import Dodge.Data.Material
import Dodge.Data.ObjectType
import Geometry.Data
import Sound.Data
data Machine = Machine
{ _mcID :: Int
@@ -38,22 +39,29 @@ data Machine = Machine
, _mcDamage :: [Damage]
, _mcType :: MachineType
, _mcMounts :: M.Map ObjectType Int
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
, _mcWidth :: Float
}
--deriving (Eq, Show, Read) --, Generic)
--hderiving (Eq, Show, Read) --Generic, Flat)
data MachineType
= McStatic
| McTerminal
| McDamSensor DamageSensor
| McProxSensor ProximitySensor
| McSensor Sensor
| McTurret {_mctTurret :: Turret}
--deriving (Eq, Show, Read) --, Generic)
--hderiving (Eq, Show, Read) --Generic, Flat)
data Turret = Turret
{ _tuWeapon :: Int
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuDir :: Float
}
--deriving (Eq, Show, Read) --, Generic)
--hderiving (Eq, Show, Read) --Generic, Flat)
makeLenses ''MachineType
makeLenses ''Machine
src/Dodge/Data/Machine/Sensor.hs
+34 -35
View File
@@ -3,52 +3,51 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine.Sensor where
module Dodge.Data.Machine.Sensor (
module Dodge.Data.Machine.Sensor,
module Dodge.Data.Machine.Sensor.Type,
) where
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.GenParams
import Dodge.Data.Item.Combine
import Geometry.Data
import Dodge.Data.Machine.Sensor.Type
data SensorType
= LaserSensor
| ElectricSensor
| ThermalSensor
| PhysicalSensor
deriving (Eq, Ord, Show, Read, Bounded, Enum)
data Sensor
= DamageSensor
{ _sensToggle :: Bool
, _sensAmount :: Int
, _sensType :: SensorType
, _sensDraw :: (PaletteColor, DecorationShape)
, _sensThreshold :: Int
}
| ProximitySensor
{ _proxStatus :: CloseToggle
, _proxDist :: Float
, _proxRequirement :: ProximityRequirement
, _sensToggle :: Bool
}
data DamageSensor = DamSensor
{ _sensAmount :: Int
, _sensType :: SensorType
, _sensThreshold :: Int
}
data ProximitySensor = ProxSensor
{ _proxSensorType :: ProximitySensorType
, _proxToggle :: Maybe Bool
}
data ProximitySensorType
= SensorWithRequirement ProximityRequirement
| NoItemZone [Point2]
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ProximityRequirement
= RequireHealth {_proxReqMinHealth :: Int}
| RequireEquipment {_proxReqEquipment :: ItemType}
| RequireDeadCreatures {_proxReqDead :: [Int]}
| RequireImpossible
deriving (Show)
makeLenses ''DamageSensor
makeLenses ''ProximitySensor
makeLenses ''ProximitySensorType
makePrisms ''ProximityRequirement
deriveJSON defaultOptions ''SensorType
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CloseToggle = NotClose | IsClose
deriving (Show)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Sensor
makeLenses ''ProximityRequirement
deriveJSON defaultOptions ''ProximityRequirement
deriveJSON defaultOptions ''ProximitySensorType
deriveJSON defaultOptions ''ProximitySensor
deriveJSON defaultOptions ''DamageSensor
instance ToJSONKey SensorType
instance FromJSONKey SensorType
deriveJSON defaultOptions ''CloseToggle
deriveJSON defaultOptions ''Sensor
src/Dodge/Data/Machine/Sensor/Type.hs
+22
View File
@@ -0,0 +1,22 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine.Sensor.Type where
import Data.Aeson
import Data.Aeson.TH
data SensorType
= LaserSensor
| ElectricSensor
| ThermalSensor
| PhysicalSensor
deriving (Eq, Ord, Show, Read, Bounded, Enum)
deriveJSON defaultOptions ''SensorType
instance ToJSONKey SensorType
instance FromJSONKey SensorType
src/Dodge/Data/MetaTree.hs
-22
View File
@@ -5,8 +5,6 @@ module Dodge.Data.MetaTree where
import Control.Lens
import Data.Tree
import System.Random
import Control.Monad.State
data MetaTree a b = MTree
{_mtLabel :: b, _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b]}
@@ -25,23 +23,3 @@ makeLenses ''MetaNode
instance Functor (MetaTree a) where
fmap f (MTree b mn bs) = MTree (f b) (mn & nodeMetaTree %~ fmap f) (map (mbTree %~ fmap f) bs)
data LayoutVars = LayVars
{ _lyGen :: StdGen
, _lyCounter :: Int
}
makeLenses ''LayoutVars
instance RandomGen LayoutVars where
genWord32 x = let (y,g) = genWord32 (x ^. lyGen)
in (y,x & lyGen .~ g)
genWord64 x = let (y,g) = genWord64 (x ^. lyGen)
in (y,x & lyGen .~ g)
split x = let (g,h) = split (x ^. lyGen) in (x & lyGen .~ g, x & lyGen .~ h)
nextLayoutInt :: State LayoutVars Int
nextLayoutInt = do
LayVars g i <- get
put $ LayVars g (i + 1)
return i
src/Dodge/Data/RightButtonOptions.hs
+16 -12
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -9,16 +9,17 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Equipment.Misc
import Dodge.Data.Item.Location
import NewInt
data RightButtonState
= NoRightButtonState
| EquipOptions {_opSel :: Int}
data RightButtonOptions
= NoRightButtonOptions
| EquipOptions { _opSel :: Int }
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data EquipmentAllocation
= DoNotMoveEquipment
| PutOnEquipment {_allocNewPos :: EquipSite}
| PutOnEquipment
{ _allocNewPos :: EquipSite
}
| MoveEquipment
{ _allocNewPos :: EquipSite
, _allocOldPos :: EquipSite
@@ -26,15 +27,18 @@ data EquipmentAllocation
| SwapEquipment
{ _allocNewPos :: EquipSite
, _allocOldPos :: EquipSite
, _allocSwapID :: NewInt ItmInt
, _allocSwapID :: Int
}
| ReplaceEquipment
{ _allocNewPos :: EquipSite
, _allocRemoveID :: NewInt ItmInt
, _allocRemoveID :: Int
}
| RemoveEquipment {_allocOldPos :: EquipSite}
| RemoveEquipment
{ _allocOldPos :: EquipSite
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''RightButtonState
makeLenses ''RightButtonOptions
makeLenses ''EquipmentAllocation
deriveJSON defaultOptions ''EquipmentAllocation
deriveJSON defaultOptions ''RightButtonState
deriveJSON defaultOptions ''RightButtonOptions
src/Dodge/Data/Room.hs
+10 -23
View File
@@ -1,6 +1,5 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
module Dodge.Data.Room (
module Dodge.Data.Room,
@@ -15,9 +14,9 @@ import Geometry
data RoomPos = RoomPos
{ _rpPos :: Point2
, _rpDir :: Float
, _rpFlags :: S.Set RoomPosFlag
, _rpType :: RPLinkStatus
, _rpPlacementUse :: S.Set UsedPos
, _rpType :: S.Set RoomPosType
, _rpLinkStatus :: RPLinkStatus
, _rpPlacementUse :: Int
}
deriving (Eq, Ord, Show)
@@ -44,7 +43,6 @@ data RoomLinkType
= OutLink
| InLink
| LabLink Int
| PolyEdge Int
| OnEdge CardinalPoint
| FromEdge CardinalPoint Int
| BlockedLink
@@ -54,7 +52,6 @@ data RoomWire
= --RoomWire Point2 Float
WallWire Point2 Float Float
-- the link constructors should probably be combined in some way
data RPLinkStatus
= UsedOutLink
{ _rplsType :: S.Set RoomLinkType
@@ -66,30 +63,20 @@ data RPLinkStatus
, _rplsInRoomID :: Int
}
| UnusedLink {_rplsType :: S.Set RoomLinkType}
| NotLink {_rpOnPath :: Bool}
| NotLink
deriving (Eq, Ord, Show)
notLink :: RPLinkStatus -> Bool
notLink = \case
NotLink {} -> True
_ -> False
data PathFromEdge = PathFromEdge CardinalPoint Int
deriving (Eq, Ord, Show)
data RoomPosFlag
= RoomPosOnGrid {_onGridFromEdges :: S.Set PathFromEdge}
| RoomPosOffGrid {_offGridFromEdges :: S.Set PathFromEdge}
deriving (Eq, Ord, Show)
data UsedPos
= UsedPosLow
| UsedPosMid
| UsedPosHigh
| UsedPosFloor
data RoomPosType
= RoomPosOnPath {_onPathFromEdges :: S.Set PathFromEdge}
| RoomPosOffPath {_offPathFromEdges :: S.Set PathFromEdge}
| RoomPosExLink
| RoomPosLab Int
deriving (Eq, Ord, Show)
makeLenses ''RoomLink
makeLenses ''RoomPos
makeLenses ''RoomPosFlag
makeLenses ''RoomPosType
makeLenses ''RPLinkStatus
src/Dodge/Data/RoomCluster.hs
+3 -2
View File
@@ -6,8 +6,9 @@ module Dodge.Data.RoomCluster where
import Control.Lens
import qualified Data.Set as S
newtype ClusterStatus = ClusterStatus
{ _csLinks :: S.Set ClusterLink
data ClusterStatus = ClusterStatus
{ _csName :: String
, _csLinks :: S.Set ClusterLink
}
data ClusterLink = OnwardCluster | SideCluster | LabelCluster Int
src/Dodge/Data/SelectionList.hs
+18 -8
View File
@@ -17,7 +17,7 @@ data ListDisplayParams = ListDisplayParams
}
data CursorDisplay
= BoundaryCursor [CardinalPoint]
= BoundaryCursor {_cursSides :: [CardinalPoint]}
| BackdropCursor
data SectionCursor = SectionCursor
@@ -26,7 +26,7 @@ data SectionCursor = SectionCursor
, _scurColor :: Color
}
data SelSection a = SelSection
data SelectionSection a = SelectionSection
{ _ssItems :: IntMap (SelectionItem a)
, _ssOffset :: Int
, _ssShownItems :: [Picture]
@@ -34,23 +34,33 @@ data SelSection a = SelSection
, _ssIndent :: Int
}
type IMSS a = IntMap (SelSection a)
type IMSS a = IntMap (SelectionSection a)
data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
data SelectionWidth
= FixedSelectionWidth Int
| UseItemWidth
data SelectionItem a
= SelItem
= SelectionItem
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: a
}
| SelectionInfo
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: Maybe a
}
makeLenses ''ListDisplayParams
makeLenses ''SelectionItem
makeLenses ''SelSection
makeLenses ''SelectionSection
makeLenses ''SectionCursor
makePrisms ''CursorDisplay
makeLenses ''CursorDisplay
src/Dodge/Data/SoundOrigin.hs
+1 -1
View File
@@ -34,7 +34,7 @@ data SoundOrigin
| GlassBreakSound Int
| MaterialSound Material Int
| TeleSound Int
| ButtonSound Int
| LeverSound Int
| Explosion Int
| Tap Int
| EBSound Int
src/Dodge/Data/Terminal.hs
+53 -10
View File
@@ -8,6 +8,8 @@ module Dodge.Data.Terminal (
module Dodge.Data.Terminal.Status,
) where
import Dodge.Data.Machine.Sensor.Type
import Sound.Data
import Color
import Control.Lens
import Data.Aeson
@@ -16,7 +18,10 @@ import qualified Data.Map.Strict as M
import Dodge.Data.BlBl
import Dodge.Data.Terminal.Status
import Dodge.Data.WorldEffect
import Sound.Data
--data TerminalInput = TerminalInput
-- { _tiSel :: (Int, Int)
-- }
data Terminal = Terminal
{ _tmID :: Int
@@ -31,40 +36,75 @@ data Terminal = Terminal
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
-- , _tmPartialCommand :: Maybe TerminalCommand
}
data TerminalLineString = TerminalLineConst String Color
data TerminalLine = TLine
{ _tlPause :: Int
, _tlString :: [TerminalLineString] -- World -> (String, Color)
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
{ _tlPause :: Int
, _tlString :: [TerminalLineString] -- World -> (String, Color)
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: BlBl
}
data TCom
= TCInfo String String -- this may not be necessary, to revisit
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument
{ _argType :: String
, _argList :: M.Map String [TerminalLine]
}
data TerminalCommandEffect
= TerminalCommandArguments EffectArguments
| TerminalCommandEffectDamageCoding
| TerminalCommandEffectSensorParameter
| TerminalCommandEffectLinkedObject
| TerminalCommandEffectHelp
| TerminalCommandEffectNoArgumentsStr String
| TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
--data TerminalCommand = TerminalCommand
-- { _tcString :: String
-- , _tcAlias :: [String]
-- , _tcHelp :: String
-- , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
-- }
data TCom = TCInfo String String
| TCBase
| TCDamageCommand
| TCSensorInfo
| TCToggles
--data TEff = TEff
-- { _teffHelp :: String
-- , _teffArgs :: PTE.TrieMap Char [TerminalLine]
-- }
data TmWdWd
= TmWdId
| TmWdWdPowerDownTerminal
| TmWdWdLeaveTerminal String
| TmWdWdDeactivateTerminal
| TmWdWdDisconnectTerminal
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
| TmGetDamageCoding SensorType
| TmGetSensor String
-- | TmDisplayCommands
makeLenses ''Terminal
makeLenses ''TerminalLine
makeLenses ''TerminalToggle
makeLenses ''EffectArguments
--makeLenses ''TerminalCommand
makeLenses ''TCom
concat
<$> mapM
@@ -72,6 +112,9 @@ concat
[ ''TerminalLineString
, ''TerminalLine
, ''TerminalToggle
, ''EffectArguments
, ''TerminalCommandEffect
-- , ''TerminalCommand
, ''TCom
, ''TmWdWd
, ''Terminal
src/Dodge/Data/Terminal/Status.hs
+2 -3
View File
@@ -9,11 +9,10 @@ import Data.Aeson.TH
data TerminalStatus
= TerminalOff
| TerminalDeactivated
| TerminalLineRead
| TerminalBusy
| TerminalTextInput {_tiText :: String}
| TerminalPressTo {_tptString :: String}
deriving (Eq,Show)
deriving (Eq)
makeLenses ''TerminalStatus
deriveJSON defaultOptions ''TerminalStatus
src/Dodge/Data/Universe.hs
+13 -10
View File
@@ -34,7 +34,7 @@ data Universe = Universe
, _uvScreenLayers :: [ScreenLayer]
, _uvIOEffects :: Universe -> IO Universe
, _uvSideEffects :: Seq SideEffect
, _uvConfig :: Config
, _uvConfig :: Configuration
, _uvTestString :: Universe -> [String]
, _uvCanContinue :: Bool
, _uvMSeed :: Maybe Int
@@ -49,8 +49,8 @@ data Universe = Universe
}
data DebugItem = DebugItem
{ _debugPic :: Picture
, _debugMessage :: [String]
{ _debugPic :: Universe -> Picture
, _debugMessage :: Universe -> [String]
, _debugInfo :: DebugInfo
}
@@ -73,23 +73,26 @@ data OptionScreenFlag = NormalOptions | GameOverOptions | SplashOptions
| LoadingScreen
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ExtraMenuOption
= BottomMenuOption { _emoMenuOption :: MenuOption }
| TopMenuOption { _emoMenuOption :: MenuOption }
| NoExtraMenuOption
data EscapeMenuOption
= BottomEscapeMenuOption { _emoMenuOption :: MenuOption }
| TopEscapeMenuOption { _emoMenuOption :: MenuOption }
| NoEscapeMenuOption
data ScreenLayer
= OptionScreen
{ _scTitle :: String
, _scOptions :: [MenuOption]
, _scOffset :: Int
, _scPositionedMenuOption :: ExtraMenuOption
, _scPositionedMenuOption :: EscapeMenuOption
, _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: [SelectionItem (Universe -> Universe,Universe->Universe)]
, _scAvailableLines :: Int
, _scDisplayTime :: Int
}
| InputScreen { _scInput :: String }
| InputScreen
{ _scInput :: String
, _scFooter :: String
}
data MenuOptionDisplay
= MODString {_modString :: String}
@@ -114,6 +117,6 @@ makeLenses ''ScreenLayer
makeLenses ''SideEffect
makeLenses ''MenuOptionDisplay
makeLenses ''MenuOption
makeLenses ''ExtraMenuOption
makeLenses ''EscapeMenuOption
makeLenses ''DebugItem
makeLenses ''DebugInfo
src/Dodge/Data/World.hs
+1 -3
View File
@@ -12,7 +12,6 @@ module Dodge.Data.World (
module Dodge.Data.Input,
) where
import qualified Data.IntMap.Strict as IM
import NewInt
import Control.Lens
import Data.IntMap.Strict (IntMap)
@@ -42,7 +41,7 @@ data World = World
, _playingSounds :: M.Map SoundOrigin Sound
, _input :: Input
, _testFloat :: Float
, _rbState :: RightButtonState
, _rbOptions :: RightButtonOptions
, _hud :: HUD
, _worldEventFlags :: Set WorldEventFlag
, _crZoning :: IntMap (IntMap IntSet)
@@ -54,7 +53,6 @@ data World = World
, _gsZoning :: IntMap (IntMap IntSet)
, _wCam :: Camera
, _unpauseClock :: Int
, _coordinates :: IM.IntMap Point2 -- temporary coordinates for world generation/placement
}
data TimeFlowStatus
src/Dodge/Data/WorldEffect.hs
+3 -5
View File
@@ -5,8 +5,6 @@
module Dodge.Data.WorldEffect where
import Dodge.Data.Item.Location
import NewInt
import Dodge.Data.LightSource
import Data.Aeson
import Data.Aeson.TH
@@ -22,9 +20,9 @@ data ItCrWdWd = ItCrWdItemHeldEffect
data WdWd
= NoWorldEffect
| SetTrigger Bool Int
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
| WorldEffects [WdWd]
| SetLSCol Point3 Int
| AccessTerminal Int
| AccessTerminal (Maybe Int)
| UnlockInv
| SoundStart SoundOrigin Point2 SoundID (Maybe Int)
| MakeStartCloudAt Point3
@@ -33,7 +31,7 @@ data WdWd
-- | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
| MakeTempLight LSParam Int
| UseInvItem Int Int -- invid presstime
| WdWdBurstFireRepetition Int (NewInt InvInt)
| WdWdBurstFireRepetition Int Int
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)

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