Modularise code concerning items
This commit is contained in:
@@ -39,6 +39,7 @@ void main()
|
|||||||
// emitLine (frontR);
|
// emitLine (frontR);
|
||||||
// emitLine (backR);
|
// emitLine (backR);
|
||||||
// emitLine (frontR);
|
// emitLine (frontR);
|
||||||
|
|
||||||
emitLine (backR);
|
emitLine (backR);
|
||||||
emitLine (backL);
|
emitLine (backL);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,12 +1,13 @@
|
|||||||
module Dodge.Critters where
|
module Dodge.Critters where
|
||||||
-- imports {{{
|
-- imports {{{
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Weapons
|
|
||||||
import Dodge.AIs
|
import Dodge.AIs
|
||||||
import Dodge.CreatureState
|
import Dodge.CreatureState
|
||||||
import Dodge.Prototypes
|
import Dodge.Prototypes
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.Smoke
|
import Dodge.Smoke
|
||||||
|
import Dodge.Item.Weapon
|
||||||
|
import Dodge.Item.Consumable
|
||||||
|
|
||||||
import Picture
|
import Picture
|
||||||
import Geometry
|
import Geometry
|
||||||
|
|||||||
@@ -0,0 +1,34 @@
|
|||||||
|
module Dodge.Item.Consumable
|
||||||
|
where
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
import Dodge.Prototypes
|
||||||
|
import Dodge.SoundLogic
|
||||||
|
|
||||||
|
import Dodge.Item.Draw
|
||||||
|
|
||||||
|
import Picture
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
|
||||||
|
medkit :: Int -> Item
|
||||||
|
medkit i = basicConsumable
|
||||||
|
{ _itIdentity = Medkit25
|
||||||
|
, _itName = "MEDKIT" ++ show i
|
||||||
|
, _itMaxStack = 9
|
||||||
|
, _itAmount = 1
|
||||||
|
, _cnEffect = heal i
|
||||||
|
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
|
||||||
|
, _itEquipPict = drawWeapon $ color blue $ circleSolid 3
|
||||||
|
, _itID = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
heal25 :: Int -> World -> Maybe World
|
||||||
|
heal25 = heal 25
|
||||||
|
heal :: Int -> Int -> World -> Maybe World
|
||||||
|
heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
|
||||||
|
| otherwise = Just $ soundOnce healSound
|
||||||
|
$ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w
|
||||||
|
|
||||||
@@ -0,0 +1,13 @@
|
|||||||
|
module Dodge.Item.Draw
|
||||||
|
where
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
|
||||||
|
import Picture
|
||||||
|
|
||||||
|
drawWeapon :: Picture -> Creature -> Int -> Drawing
|
||||||
|
drawWeapon p cr posInInv
|
||||||
|
| _crInvSel cr == posInInv = onLayer PtLayer drawnWep
|
||||||
|
| otherwise = blank
|
||||||
|
where drawnWep = uncurry translate (_crRad cr,0) p
|
||||||
|
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
module Dodge.Weapons where
|
module Dodge.Item.Weapon where
|
||||||
-- imports {{{
|
-- imports {{{
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
@@ -11,6 +11,11 @@ import Dodge.Debug
|
|||||||
import Dodge.WallCreatureCollisions
|
import Dodge.WallCreatureCollisions
|
||||||
import Dodge.Prototypes
|
import Dodge.Prototypes
|
||||||
|
|
||||||
|
import Dodge.Item.Draw
|
||||||
|
|
||||||
|
import Dodge.Item.Weapon.Bullet
|
||||||
|
import Dodge.Item.Weapon.InventoryDisplay
|
||||||
|
|
||||||
import Geometry
|
import Geometry
|
||||||
import Picture
|
import Picture
|
||||||
|
|
||||||
@@ -53,7 +58,6 @@ pistol = Weapon
|
|||||||
, _wpFireState = 0
|
, _wpFireState = 0
|
||||||
, _wpFire = shootWithSound 0
|
, _wpFire = shootWithSound 0
|
||||||
$ withAccVelWthHiteff' 0.1 (30,0) 2
|
$ withAccVelWthHiteff' 0.1 (30,0) 2
|
||||||
-- $ threeEff' bulIncCr' bulIncWall' bulHitFF'
|
|
||||||
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
|
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
|
||||||
, _wpSpread = 0.02
|
, _wpSpread = 0.02
|
||||||
, _wpRange = 20
|
, _wpRange = 20
|
||||||
@@ -76,15 +80,6 @@ pistol = Weapon
|
|||||||
defaultGun = pistol
|
defaultGun = pistol
|
||||||
defaultAutoGun = autoGun {_itScrollUp = const id
|
defaultAutoGun = autoGun {_itScrollUp = const id
|
||||||
, _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
|
, _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
|
||||||
basicWeaponDisplay :: Item -> String
|
|
||||||
basicWeaponDisplay it = midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
|
|
||||||
--basicWeaponDisplay it = rightPad 8 ' ' (_itName it) ++ leftPad 3 ' ' aIfLoaded
|
|
||||||
-- ++ "/" ++ leftPad 3 ' ' availableAmmo
|
|
||||||
where
|
|
||||||
availableAmmo = show $ _wpMaxAmmo it
|
|
||||||
aIfLoaded = case (_wpReloadState it) of
|
|
||||||
0 -> show $ _wpLoadedAmmo it
|
|
||||||
x -> "R" ++ show x
|
|
||||||
effectGun :: String -> (Int -> World -> World) -> Item
|
effectGun :: String -> (Int -> World -> World) -> Item
|
||||||
effectGun name eff = defaultGun
|
effectGun name eff = defaultGun
|
||||||
{ _itName = name ++ "Gun"
|
{ _itName = name ++ "Gun"
|
||||||
@@ -104,7 +99,6 @@ autoGun = defaultGun
|
|||||||
, _wpAmmoType = PistolBullet
|
, _wpAmmoType = PistolBullet
|
||||||
, _wpReloadTime = 80
|
, _wpReloadTime = 80
|
||||||
, _wpReloadState = 0
|
, _wpReloadState = 0
|
||||||
-- , _wpFireRate = 6
|
|
||||||
, _wpFireRate = 6
|
, _wpFireRate = 6
|
||||||
, _wpFireState = 0
|
, _wpFireState = 0
|
||||||
, _wpFire = autoFireMode
|
, _wpFire = autoFireMode
|
||||||
@@ -124,16 +118,6 @@ autoGun = defaultGun
|
|||||||
, _itScrollDown = incMode
|
, _itScrollDown = incMode
|
||||||
, _itInvDisplay = displayAutoGun
|
, _itInvDisplay = displayAutoGun
|
||||||
}
|
}
|
||||||
displayAutoGun :: Item -> String
|
|
||||||
displayAutoGun it@(Weapon {_itAttachment = mayMode})
|
|
||||||
= midPadL 10 ' ' "AUTOGUN" (' ':aIfLoaded) ++ (' ':phaseS)
|
|
||||||
where aIfLoaded = case (_wpReloadState it) of
|
|
||||||
0 -> show $ _wpLoadedAmmo it
|
|
||||||
x -> "R" ++ show x
|
|
||||||
phaseS = case mayMode of
|
|
||||||
Just (ItMode 0) -> "M"
|
|
||||||
Just (ItMode 1) -> "S"
|
|
||||||
Just (ItMode 2) -> "B"
|
|
||||||
autoFireMode = shootWithSound (fromIntegral autoGunSound)
|
autoFireMode = shootWithSound (fromIntegral autoGunSound)
|
||||||
$ withRecoil 40
|
$ withRecoil 40
|
||||||
$ torqueBefore 0.05
|
$ torqueBefore 0.05
|
||||||
@@ -245,16 +229,6 @@ lasGun = defaultAutoGun
|
|||||||
, _itScrollDown = decPhaseV
|
, _itScrollDown = decPhaseV
|
||||||
, _itInvDisplay = displayLasGun
|
, _itInvDisplay = displayLasGun
|
||||||
}
|
}
|
||||||
displayLasGun :: Item -> String
|
|
||||||
displayLasGun it@(Weapon {_itAttachment = mayPhase})
|
|
||||||
= midPadL 10 ' ' "LASER" (' ':aIfLoaded) ++ (' ':phaseS)
|
|
||||||
where aIfLoaded = case (_wpReloadState it) of
|
|
||||||
0 -> show $ _wpLoadedAmmo it
|
|
||||||
x -> "R" ++ show x
|
|
||||||
phaseS = case mayPhase of
|
|
||||||
Just (ItPhaseV 0.2) -> "V"
|
|
||||||
Just (ItPhaseV 1) -> "/"
|
|
||||||
Just (ItPhaseV 5) -> "Z"
|
|
||||||
|
|
||||||
incPhaseV :: Int -> World -> World
|
incPhaseV :: Int -> World -> World
|
||||||
incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
|
incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
|
||||||
@@ -1140,225 +1114,7 @@ torqueAfter torque feff cid w
|
|||||||
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
||||||
. itAttachment . _Just . scopePos %~ rotateV rot
|
. itAttachment . _Just . scopePos %~ rotateV rot
|
||||||
|
|
||||||
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle'
|
|
||||||
aGenBulAt' maycid col pos vel hiteff width = Bul'
|
|
||||||
{ _ptPict' = blank
|
|
||||||
, _ptUpdate' = mvGenBullet'
|
|
||||||
, _btVel' = vel
|
|
||||||
, _btColor' = col
|
|
||||||
, _btTrail' = [pos]
|
|
||||||
, _btPassThrough' = maycid
|
|
||||||
, _btWidth' = width
|
|
||||||
, _btTimer' = 90
|
|
||||||
, _btHitEffect' = hiteff
|
|
||||||
}
|
|
||||||
|
|
||||||
-- bullet effects
|
|
||||||
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
bulHitCr' bt p cr w =
|
|
||||||
let sp = head $ _btTrail' bt
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
-- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ]
|
|
||||||
mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ]
|
|
||||||
addDamage = over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
|
|
||||||
addDamageArmoured = over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> mvDams ++ dams)
|
|
||||||
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
|
||||||
flashEff = over worldEvents ((.) $ flareAt red p)
|
|
||||||
bulVel = ep -.- sp
|
|
||||||
ck cid = (+.+) (crKnockBack cid *.* bulVel)
|
|
||||||
crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
|
|
||||||
hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
|
|
||||||
cid = _crID cr
|
|
||||||
sID = newParticleKey w
|
|
||||||
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
||||||
(colID,_) = randomR (0,11) $ _randGen w
|
|
||||||
hitEffect = addDamage . hitSound . flashEff $ w
|
|
||||||
in case hasArmour cr of --shit this is ugly, to refactor
|
|
||||||
True -> if hitBack
|
|
||||||
then hitEffect
|
|
||||||
else createSpark 8 colID p1
|
|
||||||
(argV (p -.- _crPos (_creatures w IM.! cid)) + d1)
|
|
||||||
Nothing
|
|
||||||
. addDamageArmoured
|
|
||||||
$ w
|
|
||||||
where cpos = _crPos $ _creatures w IM.! cid
|
|
||||||
relHitPos = p -.- cpos
|
|
||||||
hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid))
|
|
||||||
relHitPos
|
|
||||||
> pi/2
|
|
||||||
p1 = p +.+ 2 *.* safeNormalizeV relHitPos
|
|
||||||
_ -> hitEffect
|
|
||||||
|
|
||||||
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
bulPenCr' bt p cr w
|
|
||||||
= over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> [Piercing 50 sp p ep
|
|
||||||
,Blunt 50 sp p ep
|
|
||||||
,TorqueDam 1 d1
|
|
||||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
||||||
] ++ dams
|
|
||||||
)
|
|
||||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
||||||
$ over worldEvents addPiercer
|
|
||||||
w
|
|
||||||
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
||||||
cid = _crID cr
|
|
||||||
sp = head $ _btTrail' bt
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
addPiercer = (.) $ over particles' ((:) piercer)
|
|
||||||
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
|
|
||||||
(_btHitEffect' bt) (_btWidth' bt)
|
|
||||||
) {_btTimer' = _btTimer' bt - 1}
|
|
||||||
|
|
||||||
hvBulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
hvBulHitCr' bt p cr w
|
|
||||||
= over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> [Piercing 200 sp p ep
|
|
||||||
,Blunt 100 sp p ep
|
|
||||||
,TorqueDam 1 d1
|
|
||||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
||||||
] ++ dams
|
|
||||||
)
|
|
||||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
||||||
w
|
|
||||||
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
|
||||||
cid = _crID cr
|
|
||||||
sp = head $ _btTrail' bt
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
|
|
||||||
bulIncCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
bulIncCr' bt p cr w
|
|
||||||
= over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> [Piercing 60 sp p ep
|
|
||||||
] ++ dams
|
|
||||||
)
|
|
||||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
||||||
$ incFlamelets
|
|
||||||
w
|
|
||||||
where cid = _crID cr
|
|
||||||
sp = head $ _btTrail' bt
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
v = evalState (randInCirc 1) $ _randGen w
|
|
||||||
incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3)
|
|
||||||
|
|
||||||
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
bulConCr' bt p cr w
|
|
||||||
= over (creatures . ix cid . crState . crDamage)
|
|
||||||
(\dams -> [Piercing 60 sp p ep
|
|
||||||
] ++ dams
|
|
||||||
)
|
|
||||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
|
||||||
$ mkwave
|
|
||||||
w
|
|
||||||
where cid = _crID cr
|
|
||||||
sp = head $ _btTrail' bt
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
||||||
bulHitWall' bt p x w = damageBlocks x
|
|
||||||
$ createSpark 8 colID pOut (reflectDir x) Nothing
|
|
||||||
$ set randGen g
|
|
||||||
w
|
|
||||||
where sp = head $ _btTrail' bt
|
|
||||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
(colID,g) = randomR (0,11) $ _randGen w
|
|
||||||
(a, _) = randomR (-0.1,0.1) $ _randGen w
|
|
||||||
spid = newKey $ _particles w
|
|
||||||
reflectDir wall = a + (argV $ reflectIn
|
|
||||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
||||||
(p -.- sp)
|
|
||||||
)
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
|
|
||||||
bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
||||||
bulBounceWall' bt p wl w = damageBlocks wl
|
|
||||||
$ over worldEvents addBouncer
|
|
||||||
-- yay for hack -- should have used this before? or never?
|
|
||||||
w
|
|
||||||
where sp = head $ _btTrail' bt
|
|
||||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
|
||||||
(_btHitEffect' bt) (_btWidth' bt)
|
|
||||||
) {_btTimer' = _btTimer' bt - 1}
|
|
||||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
||||||
reflectVel = (reflectIn wallV (_btVel' bt))
|
|
||||||
addBouncer = (.) (over particles' ((:) bouncer))
|
|
||||||
-- the hack is to get around the fact that the particles' list gets reset after
|
|
||||||
-- all particles in it are checked, so we cannot add to it as we accumulate over
|
|
||||||
-- this list
|
|
||||||
|
|
||||||
bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
||||||
bulIncWall' bt p wl w = damageBlocks wl
|
|
||||||
$ incFlamelets
|
|
||||||
-- yay for hack -- should have used this before? or never?
|
|
||||||
w
|
|
||||||
where sp = head $ _btTrail' bt
|
|
||||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
||||||
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
|
||||||
incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3)
|
|
||||||
|
|
||||||
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
||||||
bulConWall' bt p wl w = damageBlocks wl
|
|
||||||
$ mkwave
|
|
||||||
-- yay for hack -- should have used this before? or never?
|
|
||||||
w
|
|
||||||
where sp = head $ _btTrail' bt
|
|
||||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
|
||||||
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
|
||||||
|
|
||||||
hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
|
||||||
hvBulHitWall' bt p x w = damageBlocks x
|
|
||||||
$ set randGen g
|
|
||||||
$ foldr ($) w (sparks pOut sv)
|
|
||||||
where sp = head $ _btTrail' bt
|
|
||||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
(a, g) = randomR (-0.1,0.1) $ _randGen w
|
|
||||||
spid = newKey $ _particles w
|
|
||||||
reflectDir wall = a + (argV $ reflectIn
|
|
||||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
||||||
(p -.- sp)
|
|
||||||
)
|
|
||||||
sv = unitVectorAtAngle $ reflectDir x
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
sID = newParticleKey w
|
|
||||||
cs = take 10 $ randomRs (0,11) $ _randGen w
|
|
||||||
ds = randomRs (-0.7,0.7) $ _randGen w
|
|
||||||
ts = randomRs (4,8) $ _randGen w
|
|
||||||
sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds
|
|
||||||
bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
|
|
||||||
bulHitFF' _ _ _ = id
|
|
||||||
|
|
||||||
bulletEffect' :: HitEffect'
|
|
||||||
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
|
|
||||||
|
|
||||||
bulletParticleSideEffect :: Particle' -> HitEffect'
|
|
||||||
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff
|
|
||||||
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
|
|
||||||
|
|
||||||
reflect :: Float -> Float -> Float
|
reflect :: Float -> Float -> Float
|
||||||
reflect a b = a + 2*(a-b)
|
reflect a b = a + 2*(a-b)
|
||||||
@@ -1682,14 +1438,6 @@ fadeLine sp ep alph width col = setLayer 1 $
|
|||||||
-- ]
|
-- ]
|
||||||
-- where p x = sp +.+ x *.* (ep -.- sp)
|
-- where p x = sp +.+ x *.* (ep -.- sp)
|
||||||
|
|
||||||
closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c)
|
|
||||||
-> Maybe (Point2, Either3 a b c)
|
|
||||||
closestOfThree p x1 x2 x3 = listToMaybe $ sortBy g $ catMaybes [fmap f1 x1,fmap f2 x2,fmap f3 x3]
|
|
||||||
where f1 (r1,s1) = (r1, E3x1 s1)
|
|
||||||
f2 (r2,s2) = (r2, E3x2 s2)
|
|
||||||
f3 (r3,s3) = (r3, E3x3 s3)
|
|
||||||
g (x,_) (y,_) = compare (magV (x -.- p)) (magV (y -.- p))
|
|
||||||
|
|
||||||
grenadeLauncher :: Item
|
grenadeLauncher :: Item
|
||||||
grenadeLauncher = pistol
|
grenadeLauncher = pistol
|
||||||
|
|
||||||
@@ -2012,24 +1760,6 @@ remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5
|
|||||||
remoteBombUnarmedPic :: Picture
|
remoteBombUnarmedPic :: Picture
|
||||||
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
||||||
|
|
||||||
drawWeapon :: Picture -> Creature -> Int -> Drawing
|
|
||||||
drawWeapon p cr posInInv
|
|
||||||
| _crInvSel cr == posInInv = onLayer PtLayer drawnWep
|
|
||||||
| otherwise = blank
|
|
||||||
where drawnWep = uncurry translate (_crRad cr,0) p
|
|
||||||
|
|
||||||
medkit :: Int -> Item
|
|
||||||
medkit i = basicConsumable
|
|
||||||
{ _itIdentity = Medkit25
|
|
||||||
, _itName = "MEDKIT" ++ show i
|
|
||||||
, _itMaxStack = 9
|
|
||||||
, _itAmount = 1
|
|
||||||
, _cnEffect = heal i
|
|
||||||
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
|
|
||||||
, _itEquipPict = drawWeapon $ color blue $ circleSolid 3
|
|
||||||
, _itID = Nothing
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
makeTeslaArcAt :: Int -> Point2 -> Float -> Particle
|
makeTeslaArcAt :: Int -> Point2 -> Float -> Particle
|
||||||
makeTeslaArcAt i pos dir = Particle
|
makeTeslaArcAt i pos dir = Particle
|
||||||
@@ -2249,13 +1979,6 @@ latchkeyPic = color yellow $
|
|||||||
|
|
||||||
-- }}}
|
-- }}}
|
||||||
|
|
||||||
heal25 :: Int -> World -> Maybe World
|
|
||||||
heal25 = heal 25
|
|
||||||
heal :: Int -> Int -> World -> Maybe World
|
|
||||||
heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
|
|
||||||
| otherwise = Just $ soundOnce healSound
|
|
||||||
$ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w
|
|
||||||
|
|
||||||
forceFieldFire :: Int -> World -> World
|
forceFieldFire :: Int -> World -> World
|
||||||
forceFieldFire cid w = w
|
forceFieldFire cid w = w
|
||||||
|
|
||||||
@@ -0,0 +1,238 @@
|
|||||||
|
module Dodge.Item.Weapon.Bullet
|
||||||
|
where
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
import Dodge.WorldActions
|
||||||
|
import Dodge.SoundLogic
|
||||||
|
import Dodge.RandomHelp
|
||||||
|
|
||||||
|
import Geometry
|
||||||
|
|
||||||
|
import System.Random
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
import Control.Monad.State
|
||||||
|
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
|
||||||
|
import Picture
|
||||||
|
|
||||||
|
-- bullet effects
|
||||||
|
bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
bulHitCr' bt p cr w =
|
||||||
|
let sp = head $ _btTrail' bt
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
-- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ]
|
||||||
|
mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ]
|
||||||
|
addDamage = over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> (Piercing 100 sp p ep : mvDams) ++ dams)
|
||||||
|
addDamageArmoured = over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> mvDams ++ dams)
|
||||||
|
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
||||||
|
flashEff = over worldEvents ((.) $ flareAt red p)
|
||||||
|
bulVel = ep -.- sp
|
||||||
|
ck cid = (+.+) (crKnockBack cid *.* bulVel)
|
||||||
|
crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid
|
||||||
|
hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr
|
||||||
|
cid = _crID cr
|
||||||
|
sID = newParticleKey w
|
||||||
|
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||||
|
(colID,_) = randomR (0,11) $ _randGen w
|
||||||
|
hitEffect = addDamage . hitSound . flashEff $ w
|
||||||
|
in case hasArmour cr of --shit this is ugly, to refactor
|
||||||
|
True -> if hitBack
|
||||||
|
then hitEffect
|
||||||
|
else createSpark 8 colID p1
|
||||||
|
(argV (p -.- _crPos (_creatures w IM.! cid)) + d1)
|
||||||
|
Nothing
|
||||||
|
. addDamageArmoured
|
||||||
|
$ w
|
||||||
|
where cpos = _crPos $ _creatures w IM.! cid
|
||||||
|
relHitPos = p -.- cpos
|
||||||
|
hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid))
|
||||||
|
relHitPos
|
||||||
|
> pi/2
|
||||||
|
p1 = p +.+ 2 *.* safeNormalizeV relHitPos
|
||||||
|
_ -> hitEffect
|
||||||
|
|
||||||
|
bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
bulPenCr' bt p cr w
|
||||||
|
= over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> [Piercing 50 sp p ep
|
||||||
|
,Blunt 50 sp p ep
|
||||||
|
,TorqueDam 1 d1
|
||||||
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||||
|
] ++ dams
|
||||||
|
)
|
||||||
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||||
|
$ over worldEvents addPiercer
|
||||||
|
w
|
||||||
|
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||||
|
cid = _crID cr
|
||||||
|
sp = head $ _btTrail' bt
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
addPiercer = (.) $ over particles' ((:) piercer)
|
||||||
|
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
|
||||||
|
(_btHitEffect' bt) (_btWidth' bt)
|
||||||
|
) {_btTimer' = _btTimer' bt - 1}
|
||||||
|
|
||||||
|
hvBulHitCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
hvBulHitCr' bt p cr w
|
||||||
|
= over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> [Piercing 200 sp p ep
|
||||||
|
,Blunt 100 sp p ep
|
||||||
|
,TorqueDam 1 d1
|
||||||
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||||
|
] ++ dams
|
||||||
|
)
|
||||||
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||||
|
w
|
||||||
|
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||||
|
cid = _crID cr
|
||||||
|
sp = head $ _btTrail' bt
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
|
||||||
|
bulIncCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
bulIncCr' bt p cr w
|
||||||
|
= over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> [Piercing 60 sp p ep
|
||||||
|
] ++ dams
|
||||||
|
)
|
||||||
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||||
|
$ incFlamelets
|
||||||
|
w
|
||||||
|
where cid = _crID cr
|
||||||
|
sp = head $ _btTrail' bt
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
v = evalState (randInCirc 1) $ _randGen w
|
||||||
|
incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3)
|
||||||
|
|
||||||
|
bulConCr' :: Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
bulConCr' bt p cr w
|
||||||
|
= over (creatures . ix cid . crState . crDamage)
|
||||||
|
(\dams -> [Piercing 60 sp p ep
|
||||||
|
] ++ dams
|
||||||
|
)
|
||||||
|
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||||
|
$ mkwave
|
||||||
|
w
|
||||||
|
where cid = _crID cr
|
||||||
|
sp = head $ _btTrail' bt
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||||
|
bulHitWall' bt p x w = damageBlocks x
|
||||||
|
$ createSpark 8 colID pOut (reflectDir x) Nothing
|
||||||
|
$ set randGen g
|
||||||
|
w
|
||||||
|
where sp = head $ _btTrail' bt
|
||||||
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
(colID,g) = randomR (0,11) $ _randGen w
|
||||||
|
(a, _) = randomR (-0.1,0.1) $ _randGen w
|
||||||
|
spid = newKey $ _particles w
|
||||||
|
reflectDir wall = a + (argV $ reflectIn
|
||||||
|
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||||
|
(p -.- sp)
|
||||||
|
)
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
|
||||||
|
bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||||
|
bulBounceWall' bt p wl w = damageBlocks wl
|
||||||
|
$ over worldEvents addBouncer
|
||||||
|
-- yay for hack -- should have used this before? or never?
|
||||||
|
w
|
||||||
|
where sp = head $ _btTrail' bt
|
||||||
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
||||||
|
(_btHitEffect' bt) (_btWidth' bt)
|
||||||
|
) {_btTimer' = _btTimer' bt - 1}
|
||||||
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||||
|
reflectVel = (reflectIn wallV (_btVel' bt))
|
||||||
|
addBouncer = (.) (over particles' ((:) bouncer))
|
||||||
|
-- the hack is to get around the fact that the particles' list gets reset after
|
||||||
|
-- all particles in it are checked, so we cannot add to it as we accumulate over
|
||||||
|
-- this list
|
||||||
|
|
||||||
|
bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||||
|
bulIncWall' bt p wl w = damageBlocks wl
|
||||||
|
$ incFlamelets
|
||||||
|
-- yay for hack -- should have used this before? or never?
|
||||||
|
w
|
||||||
|
where sp = head $ _btTrail' bt
|
||||||
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||||
|
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
||||||
|
incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3)
|
||||||
|
|
||||||
|
bulConWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||||
|
bulConWall' bt p wl w = damageBlocks wl
|
||||||
|
$ mkwave
|
||||||
|
-- yay for hack -- should have used this before? or never?
|
||||||
|
w
|
||||||
|
where sp = head $ _btTrail' bt
|
||||||
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||||
|
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
|
||||||
|
|
||||||
|
hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
|
||||||
|
hvBulHitWall' bt p x w = damageBlocks x
|
||||||
|
$ set randGen g
|
||||||
|
$ foldr ($) w (sparks pOut sv)
|
||||||
|
where sp = head $ _btTrail' bt
|
||||||
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
(a, g) = randomR (-0.1,0.1) $ _randGen w
|
||||||
|
spid = newKey $ _particles w
|
||||||
|
reflectDir wall = a + (argV $ reflectIn
|
||||||
|
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||||
|
(p -.- sp)
|
||||||
|
)
|
||||||
|
sv = unitVectorAtAngle $ reflectDir x
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
sID = newParticleKey w
|
||||||
|
cs = take 10 $ randomRs (0,11) $ _randGen w
|
||||||
|
ds = randomRs (-0.7,0.7) $ _randGen w
|
||||||
|
ts = randomRs (4,8) $ _randGen w
|
||||||
|
sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds
|
||||||
|
bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World
|
||||||
|
bulHitFF' _ _ _ = id
|
||||||
|
|
||||||
|
bulletEffect' :: HitEffect'
|
||||||
|
bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF'
|
||||||
|
|
||||||
|
bulletParticleSideEffect :: Particle' -> HitEffect'
|
||||||
|
bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff
|
||||||
|
where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]})
|
||||||
|
|
||||||
|
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle'
|
||||||
|
aGenBulAt' maycid col pos vel hiteff width = Bul'
|
||||||
|
{ _ptPict' = blank
|
||||||
|
, _ptUpdate' = mvGenBullet'
|
||||||
|
, _btVel' = vel
|
||||||
|
, _btColor' = col
|
||||||
|
, _btTrail' = [pos]
|
||||||
|
, _btPassThrough' = maycid
|
||||||
|
, _btWidth' = width
|
||||||
|
, _btTimer' = 90
|
||||||
|
, _btHitEffect' = hiteff
|
||||||
|
}
|
||||||
@@ -0,0 +1,34 @@
|
|||||||
|
module Dodge.Item.Weapon.InventoryDisplay
|
||||||
|
where
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
|
||||||
|
basicWeaponDisplay :: Item -> String
|
||||||
|
basicWeaponDisplay it = midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
|
||||||
|
where
|
||||||
|
availableAmmo = show $ _wpMaxAmmo it
|
||||||
|
aIfLoaded = case (_wpReloadState it) of
|
||||||
|
0 -> show $ _wpLoadedAmmo it
|
||||||
|
x -> "R" ++ show x
|
||||||
|
|
||||||
|
displayAutoGun :: Item -> String
|
||||||
|
displayAutoGun it@(Weapon {_itAttachment = mayMode})
|
||||||
|
= midPadL 10 ' ' "AUTOGUN" (' ':aIfLoaded) ++ (' ':phaseS)
|
||||||
|
where aIfLoaded = case (_wpReloadState it) of
|
||||||
|
0 -> show $ _wpLoadedAmmo it
|
||||||
|
x -> "R" ++ show x
|
||||||
|
phaseS = case mayMode of
|
||||||
|
Just (ItMode 0) -> "M"
|
||||||
|
Just (ItMode 1) -> "S"
|
||||||
|
Just (ItMode 2) -> "B"
|
||||||
|
|
||||||
|
displayLasGun :: Item -> String
|
||||||
|
displayLasGun it@(Weapon {_itAttachment = mayPhase})
|
||||||
|
= midPadL 10 ' ' "LASER" (' ':aIfLoaded) ++ (' ':phaseS)
|
||||||
|
where aIfLoaded = case (_wpReloadState it) of
|
||||||
|
0 -> show $ _wpLoadedAmmo it
|
||||||
|
x -> "R" ++ show x
|
||||||
|
phaseS = case mayPhase of
|
||||||
|
Just (ItPhaseV 0.2) -> "V"
|
||||||
|
Just (ItPhaseV 1) -> "/"
|
||||||
|
Just (ItPhaseV 5) -> "Z"
|
||||||
@@ -126,6 +126,7 @@ noBoundClip = not . boundClip
|
|||||||
|
|
||||||
connectRoom :: a -> Tree (Either a a)
|
connectRoom :: a -> Tree (Either a a)
|
||||||
connectRoom r = Node (Right r) []
|
connectRoom r = Node (Right r) []
|
||||||
|
|
||||||
deadRoom :: a -> Tree (Either a a)
|
deadRoom :: a -> Tree (Either a a)
|
||||||
deadRoom r = Node (Left r) []
|
deadRoom r = Node (Left r) []
|
||||||
|
|
||||||
|
|||||||
+8
-6
@@ -1,7 +1,7 @@
|
|||||||
module Dodge.Rooms where
|
module Dodge.Rooms where
|
||||||
-- imports {{{
|
-- imports {{{
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Weapons
|
import Dodge.Item.Weapon
|
||||||
import Dodge.Critters
|
import Dodge.Critters
|
||||||
import Dodge.LevelGen
|
import Dodge.LevelGen
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
@@ -89,8 +89,6 @@ corridor = Room
|
|||||||
where lnks = [((20,70) ,0)
|
where lnks = [((20,70) ,0)
|
||||||
,((20,80) +.+ rotateV (0-pi/3) (-20,0), pi/6)
|
,((20,80) +.+ rotateV (0-pi/3) (-20,0), pi/6)
|
||||||
,((20,80) +.+ rotateV ( pi/3) ( 20,0),0-pi/6)
|
,((20,80) +.+ rotateV ( pi/3) ( 20,0),0-pi/6)
|
||||||
-- ,((40,0) +.+ rotateV ( pi/3) (-20,0), 2*pi/3)
|
|
||||||
-- ,(( 0,0) +.+ rotateV (0-pi/3) ( 20,0),0-2*pi/3)
|
|
||||||
,((20,10) ,pi)
|
,((20,10) ,pi)
|
||||||
]
|
]
|
||||||
corridorN :: Room
|
corridorN :: Room
|
||||||
@@ -207,7 +205,8 @@ door = Room
|
|||||||
{ _rmPolys = [rectNSWE 40 0 0 40]
|
{ _rmPolys = [rectNSWE 40 0 0 40]
|
||||||
, _rmLinks = lnks
|
, _rmLinks = lnks
|
||||||
, _rmPath = [((20,35),(20,5))]
|
, _rmPath = [((20,35),(20,5))]
|
||||||
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
|
-- door extends into side walls (for shadows as rendered 12/03)
|
||||||
|
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (-10,0) (50,0)]
|
||||||
, _rmBound = []
|
, _rmBound = []
|
||||||
}
|
}
|
||||||
where lnks = [((20,35),0)
|
where lnks = [((20,35),0)
|
||||||
@@ -531,11 +530,14 @@ weaponLongCorridor = do
|
|||||||
i2 <- state $ randomR (2,5)
|
i2 <- state $ randomR (2,5)
|
||||||
let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom)
|
let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom)
|
||||||
let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
|
let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
|
||||||
return $ Node (Left root) [branch1,branch2]
|
return $ Node (Left $ addLS root) [branch1,branch2]
|
||||||
where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC
|
where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC
|
||||||
,PS (-10,40) (-pi/2) $ randC
|
,PS (-10,40) (-pi/2) $ randC
|
||||||
]
|
]
|
||||||
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon]
|
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon
|
||||||
|
,PS (20,60) 0 $ basicLS
|
||||||
|
]
|
||||||
|
addLS = id -- set rmPS [PS (0,60) 0 $ basicLS]
|
||||||
|
|
||||||
critInDeadEnd :: Room
|
critInDeadEnd :: Room
|
||||||
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom
|
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom
|
||||||
|
|||||||
Reference in New Issue
Block a user