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

Refactor item drawing

Browse Source
This commit is contained in:
justin
2021-10-01 23:01:36 +01:00
parent 5f17841811
commit 8c1496e140
28 changed files with 248 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+5 -5
View File
@@ -285,7 +285,7 @@ data Item
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: SPic
, _itFloorPict :: Item -> SPic
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
@@ -310,7 +310,7 @@ data Item
, _itMaxStack :: Int
, _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: SPic
, _itFloorPict :: Item -> SPic
, _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
@@ -324,7 +324,7 @@ data Item
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: SPic
, _itFloorPict :: Item -> SPic
, _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
@@ -336,7 +336,7 @@ data Item
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: SPic
, _itFloorPict :: Item -> SPic
, _itEquipPict :: Creature -> Int -> SPic
, _itIdentity :: ItemIdentity
, _itEffect :: ItEffect
@@ -354,7 +354,7 @@ data Item
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: SPic
, _itFloorPict :: Item -> SPic
, _twMaxRange :: Float
, _twAccuracy :: Float
, _itUse :: Item -> Creature -> World -> World
src/Dodge/Default.hs
+3 -3
View File
@@ -130,7 +130,7 @@ defaultEquipment = Equipment
, _itName = "genericEquipment"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \_ -> (,) emptySH $ setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = NoItEffect
, _itHammer = HammerUp
@@ -152,7 +152,7 @@ defaultConsumable = Consumable
, _itMaxStack = 9
, _itAmount = 1
, _cnEffect = \_ _ -> Nothing
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color blue $ circleSolid 3
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ circleSolid 3
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itInvColor = blue
@@ -199,7 +199,7 @@ defaultIt = Consumable
, _itMaxStack = 3
, _itAmount = 2
, _cnEffect = const return
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itInvDisplay = _itName
src/Dodge/Default/Weapon.hs
+1 -1
View File
@@ -29,7 +29,7 @@ defaultGun = Weapon
, _wpSpread = 0.02
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = emptyBlank
, _itFloorPict = \_ -> emptyBlank
, _itAmount = 1
, _itMaxStack = 1
, _itAimingSpeed = 1
src/Dodge/Item.hs
+2 -2
View File
@@ -16,7 +16,7 @@ keyToken n = defaultEquipment
, _itName = "KEYTOKEN "++show n
, _itMaxStack = 5
, _itAmount = 1
, _itFloorPict = (,) emptySH $ setDepth 0.5 keyPic
, _itFloorPict = \it -> (,) emptySH $ setDepth 0.5 keyPic
, _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
, _itEffect = NoItEffect
, _itHammer = HammerUp
@@ -40,7 +40,7 @@ latchkey n = defaultEquipment
, _itName = "KEY "++show n
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ setDepth 0.5 latchkeyPic
, _itFloorPict = \it -> (,) emptySH $ setDepth 0.5 latchkeyPic
, _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
, _itEffect = NoItEffect
, _itHammer = HammerUp
src/Dodge/Item/Consumable.hs
+1 -1
View File
@@ -22,7 +22,7 @@ medkit i = defaultConsumable
, _itMaxStack = 9
, _itAmount = 1
, _cnEffect = heal i
, _itFloorPict = (,) emptySH $ setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3
, _itFloorPict = \it -> (,) emptySH $ setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3
, _itEquipPict = pictureItem $ (,) emptySH $ color blue $ circleSolid 3
, _itID = Nothing
}
src/Dodge/Item/Draw.hs
+21 -3
View File
@@ -10,13 +10,31 @@ import ShapePicture
import qualified Data.IntMap.Strict as IM
import Control.Lens
{- | Places an item picture onto a creature when the item is selected. -}
pictureWeaponOnAim
:: (Item -> SPic)
-> Creature
-> Int -- ^ Position of item in inventory
-> SPic
pictureWeaponOnAim f cr i = pictureWeaponOnAimItem pic cr i
where
pic = f (_crInv cr IM.! i)
pictureWeaponAim
:: (Item -> SPic)
-> Creature
-> Int -- ^ Position of item in inventory
-> SPic
pictureWeaponAim f cr i = pictureWeaponOnAimItem pic cr i
where
pic = f (_crInv cr IM.! i)
{- | Places an item picture onto a creature when the item is selected. -}
pictureWeaponOnAimItem
:: SPic
-> Creature
-> Int -- ^ Position of item in inventory
-> SPic
pictureWeaponOnAim p cr posInInv
pictureWeaponOnAimItem p cr posInInv
| isSelected && _posture (_crStance cr) == Aiming && isTwisting
= shoulderD twistWep
| isSelected && _posture (_crStance cr) == Aiming && isOneHand
@@ -29,7 +47,7 @@ pictureWeaponOnAim p cr posInInv
= handD holsteredWep
| otherwise = emptyBlank
where
shoulderD = translateSPz 20.5
shoulderD = translateSPz 18
handD = translateSPz 15
isSelected = _crInvSel cr == posInInv
drawnWep = translateSPf (_crRad cr) 0 p
src/Dodge/Item/Equipment.hs
+4 -4
View File
@@ -15,7 +15,7 @@ magShield = defaultEquipment
, _itName = "MAGSHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
}
@@ -25,7 +25,7 @@ flameShield = defaultEquipment
, _itName = "FLAMESHIELD"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \cr _ -> (,) emptySH $ onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing
}
@@ -36,7 +36,7 @@ frontArmour = defaultEquipment
, _itName = "FARMOUR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures
[color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
]
@@ -54,7 +54,7 @@ jetPack = defaultEquipment
, _itName = "JETPACK"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH $ onLayer CrLayer
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
, _itEffect = NoItEffect
src/Dodge/Item/Weapon.hs
+82 -51
View File
@@ -83,7 +83,7 @@ pistol = defaultGun
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim pistolPic
, _itEquipPict = pictureWeaponAim pistolPic
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itEffect = wpRecock
@@ -93,11 +93,22 @@ pistol = defaultGun
, _itWorldTrigger = Nothing
, _wpAmmo = basicBullet
}
pistolPic :: SPic
pistolPic =
( colorSH green $ upperPrismPoly 3 $ rectNESW 5 5 (-5) (-5)
pistolPic :: Item -> SPic
pistolPic it =
( (colorSH green $ prismPoly
(map (addZ 3) $ rectNESW 3 3 (-3) (-3))
(map (addZ 0) $ rectNESW 5 3 (-5) (-7))
)
<> translateSH (V3 (-4) (5.5) 4) (rotateSH (pi) $ bulletClip am)
, mempty
)
where
am = loadedAmmo it
bulletClip :: Int -> Shape
bulletClip x = (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5))
where
am = fromIntegral x
effectGun :: String -> (Creature -> World -> World) -> Item
@@ -124,13 +135,13 @@ rezGun = defaultGun
[]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
, _itAimingSpeed = 0.4
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color chartreuse $ pictures
, _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color chartreuse $ pictures
[polygon $ rectNESW 7 3 1 (-3)
,polygon $ rectNESW (-1) 3 (-7) (-3)
]
@@ -155,11 +166,11 @@ teslaGun = defaultGun
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = teslaGunPic
, _itFloorPict = \it -> teslaGunPic
, _itAimingSpeed = 0.4
, _itZoom = defaultItZoom
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim teslaGunPic
, _itEquipPict = pictureWeaponOnAim $ \it -> teslaGunPic
}
teslaGunPic :: SPic
teslaGunPic =
@@ -192,19 +203,25 @@ lasGun = defaultAutoGun
]
, _wpSpread = 0.001
, _wpRange = 20
, _itFloorPict = lasGunPic
, _itFloorPict = \it -> lasGunPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim lasGunPic
, _itEquipPict = pictureWeaponOnAim $ \it -> lasGunPic
, _itAttachment = ItCharMode $ Seq.fromList "/VZ"
, _itScroll = scrollCharMode
, _itInvDisplay = basicWeaponDisplay
}
lasGunPic :: SPic
lasGunPic =
( colorSH blue . upperPrismPoly 5 $ rectNESW 3 15 (-3) (-15)
( colorSH blue $
(upperPrismPoly 4 $ rectNESW 3 15 1 (-15))
<> (upperPrismPoly 4 $ rectNESW (-1) 15 (-3) (-15))
-- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2))
<> (upperPrismPoly 1 $ rectNESW (3) 15 (-3) (-15))
, mempty
)
where
l = 0
forceFieldGun :: Item
forceFieldGun = defaultGun
{ _itName = "FORCEFIELD"
@@ -218,7 +235,7 @@ forceFieldGun = defaultGun
, _itUse = undefined
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
}
@@ -257,10 +274,10 @@ tractorGun = defaultAutoGun
]
, _wpSpread = 0.00001
, _wpRange = 20
, _itFloorPict = tractorGunSPic
, _itFloorPict = \it -> tractorGunSPic
, _itAimingSpeed = 0.4
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim tractorGunSPic
, _itEquipPict = pictureWeaponOnAim $ \it -> tractorGunSPic
}
-- TODO own picture for tractor gun
tractorGunSPic :: SPic
@@ -288,10 +305,10 @@ remoteLauncher = defaultGun
]
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = remoteLauncherSPic
, _itFloorPict = \it -> remoteLauncherSPic
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim remoteLauncherSPic
, _itEquipPict = pictureWeaponOnAim $ \it -> remoteLauncherSPic
, _itAttachment = ItScope (V2 0 0) 0 1 True
}
remoteLauncherSPic :: SPic
@@ -319,10 +336,10 @@ hvAutoGun = defaultAutoGun
, withMuzFlareI
]
, _wpRange = 20
, _itFloorPict = hvAutoGunPic
, _itFloorPict = \it -> hvAutoGunPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim hvAutoGunPic
, _itEquipPict = pictureWeaponOnAim $ \it -> hvAutoGunPic
, _wpAmmo = hvBullet
}
hvAutoGunPic :: SPic
@@ -353,11 +370,11 @@ ltAutoGun = defaultAutoGun
]
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = ltAutoGunPic
, _itFloorPict = \it -> ltAutoGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim ltAutoGunPic
, _itEquipPict = pictureWeaponOnAim $ \it -> ltAutoGunPic
, _itAimStance = OneHand
, _wpAmmo = ltBullet
}
@@ -412,10 +429,10 @@ miniGun = defaultAutoGun
, withSmoke 1 black 20 200 5
]
, _wpRange = 20
, _itFloorPict = miniGunPict
, _itFloorPict = miniGunPictItem
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim miniGunPict
, _itEquipPict = pictureWeaponAim miniGunPictItem
, _wpAmmo = basicBullet
}
where
@@ -430,13 +447,27 @@ miniGun = defaultAutoGun
[ 0.25, 0.5, 0.9]
--[ 0.75, 0.5, 0.25]
--[ 0, 0, 0]
miniGunPict :: SPic
miniGunPict =
( (translateSHf 5 0 . colorSH red $ upperPrismPoly 10 $ rectNESW 9 7 (-9) (-5))
++ (colorSH red . upperPrismPoly 5 $ rectNESW 4 12 (-4) (-12))
miniGunPictItem :: Item -> SPic
miniGunPictItem it = miniGunPict spin (loadedAmmo it)
where
spin = 10 * _wpLoadedAmmo it + _wpCurWarmUp it
miniGunPict :: Int -> Int -> SPic
miniGunPict spin am =
( ( rotateSHx a .translateSH (V3 5 0 (-9)) . colorSH red $ upperPrismPoly 18 $ rectNESW 9 7 (-9) (-5))
<> (colorSH red $ prismPoly
(map (addZ 5) $ rectNESW 2 12 (-2) (-12))
(map (addZ 0) $ rectNESW 4 12 (-4) (-16))
)
<> f (-1) 0
<> f (-7) 0
, mempty
)
where
a = fromIntegral spin / 100
x = fromIntegral am / 20
f y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) (y) 3 (y-5))
spreadGun :: Item
spreadGun = defaultGun
{ _itName = "SPREAD"
@@ -461,10 +492,10 @@ spreadGun = defaultGun
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = spreadGunPic
, _itFloorPict = \it -> spreadGunPic
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEquipPict = pictureWeaponOnAim spreadGunPic
, _itEquipPict = pictureWeaponOnAim $ \it -> spreadGunPic
, _wpAmmo = basicBullet
, _wpNumBarrels = 50
}
@@ -496,12 +527,12 @@ multGun = defaultGun
]
, _wpSpread = spreadGunSpread
, _wpRange = 20
, _itFloorPict = multGunSPic
, _itFloorPict = \it -> multGunSPic
, _itAimingSpeed = 0.4
, _itAimingRange = 1
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
, _itEquipPict = pictureWeaponOnAim multGunSPic
, _itEquipPict = pictureWeaponOnAim $ \it -> multGunSPic
, _itAimStance = TwoHandTwist
, _wpAmmo = basicBullet
, _wpNumBarrels = 5
@@ -544,12 +575,12 @@ longGun = defaultGun
, withMuzFlareI
]
, _wpRange = 200
, _itFloorPict = longGunSPic
, _itFloorPict = \it -> longGunSPic
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
, _itEquipPict = pictureWeaponOnAim longGunSPic
, _itEquipPict = pictureWeaponOnAim $ \it -> longGunSPic
, _itScroll = zoomLongGun
, _itAttachment = ItScope (V2 0 0) 0 1 False
, _itEffect = itemLaserScopeEffect
@@ -591,11 +622,11 @@ poisonSprayer = defaultAutoGun
, spreadNumI
]
, _wpRange = 8
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.2
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _wpSpread = 0.1
, _wpNumBarrels = 3
}
@@ -618,12 +649,12 @@ flamer = defaultAutoGun
]
, _wpSpread = 0
, _wpRange = 8
, _itFloorPict = flamerPic
, _itFloorPict = \it -> flamerPic
, _itAimingSpeed = 0.5
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
, _itEquipPict = pictureWeaponOnAim flamerPic
, _itEquipPict = pictureWeaponOnAim $ \it -> flamerPic
, _itAttachment = NoItAttachment
}
flamerPic :: SPic
@@ -651,7 +682,7 @@ blinkGun = defaultGun
, _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
}
@@ -669,7 +700,7 @@ boosterGun = defaultGun
, _itLeftClickUse = Just $ boostSelfL 10
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEffect = resetAttachmentID
@@ -842,7 +873,7 @@ grenade = Throwable
, _itIdentity = Grenade
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = \_ -> throwGrenade makeExplosionAt
@@ -853,7 +884,7 @@ grenade = Throwable
, _itAimingRange = 0
, _itZoom = defaultItZoom
, _itAimZoom = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
, _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
, _itEquipPict = pictureWeaponOnAim $ \it -> grenadePic fuseTime
, _itID = Nothing
, _itUseRate = 25
, _itUseTime = 0
@@ -895,7 +926,7 @@ remoteBomb = defaultThrowable
, _itIdentity = RemoteBomb
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
, _itUse = const throwRemoteBomb
@@ -903,7 +934,7 @@ remoteBomb = defaultThrowable
[ hammerCheckI
]
, _itAttachment = ItScope (V2 0 0) 0 1 True
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH remoteBombUnarmedPic
, _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH remoteBombUnarmedPic
}
fireRemoteLauncher :: Creature -> World -> World
@@ -1053,7 +1084,7 @@ explodeRemoteBomb itid pjid cr w
cid = _crID cr
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict )
(pictureWeaponOnAim $ (,) emptySH remoteBombUnarmedPic)
(pictureWeaponOnAim $ \it -> (,) emptySH remoteBombUnarmedPic)
-- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
j = _crInvSel $ _creatures w IM.! cid
remoteBombPic
@@ -1075,7 +1106,7 @@ pipe = Craftable
, _itName = "PIPE"
, _itMaxStack = 3
, _itAmount = 3
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> emptyBlank
, _itID = Nothing
, _itInvDisplay = _itName
@@ -1101,13 +1132,13 @@ radar = defaultGun
, _wpSpread = autogunSpread
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingRange = 1
, _itZoom = defaultItZoom { _itZoomMax = 1}
, _itAimZoom = defaultItZoom { _itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Sends out pulses that display creatures. -}
@@ -1127,13 +1158,13 @@ sonar = defaultGun
]
, _wpRange = 20
, _itHammer = HammerUp
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAmount = 1
, _itMaxStack = 1
, _itAimingRange = 1
, _itZoom = defaultItZoom {_itZoomMax = 1}
, _itAimZoom = defaultItZoom {_itZoomMax = 1}
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
, _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
}
{- |
Automatically sends out pulses that display creatures. -}
@@ -1143,7 +1174,7 @@ autoSonar = defaultEquipment
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = autoSonarEffect
, _itID = Nothing
@@ -1160,7 +1191,7 @@ autoRadar = defaultEquipment
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = autoRadarEffect
, _itID = Nothing
src/Dodge/Item/Weapon/AmmoParams.hs
+5
View File
@@ -46,3 +46,8 @@ withDelayedVelWthHiteff vfact vel width hiteff cr = over particles (newbul : )
newbul = aDelayedBulAt vfact (Just cid) pos (rotateV dir vel) hiteff width
dir = _crDir cr
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
loadedAmmo :: Item -> Int
loadedAmmo it
| _wpReloadState it == 0 = fromIntegral $ _wpLoadedAmmo it
| otherwise = 0
src/Dodge/Item/Weapon/AutoGun.hs
+7 -3
View File
@@ -63,13 +63,17 @@ autoGun = defaultAutoGun
, _itInvDisplay = basicWeaponDisplay
, _wpAmmo = basicBullet
}
autoGunPic :: SPic
autoGunPic =
( colorSH red $ prismPoly
autoGunPic :: Item -> SPic
autoGunPic it =
( (colorSH red $ prismPoly
(map (addZ 5) $ rectNESW 2 12 (-2) (-8))
(map (addZ 0) $ rectNESW 4 12 (-4) (-12))
)
<> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5))
, mempty
)
where
x = fromIntegral $ loadedAmmo it
autogunSpread :: Float
autogunSpread = 0.07
src/Dodge/Item/Weapon/Bezier.hs
+2 -2
View File
@@ -35,8 +35,8 @@ bezierGun = defaultGun
. withRecoilI 40
. torqueBefore 0.05
]
, _itFloorPict = bezierGunSPic
, _itEquipPict = pictureWeaponOnAim bezierGunSPic
, _itFloorPict = \it -> bezierGunSPic
, _itEquipPict = pictureWeaponOnAim $ \it -> bezierGunSPic
, _itAttachment = NoItAttachment
, _itScroll = \_ _ -> removeItTarget
, _itHammer = HammerUp
src/Dodge/Item/Weapon/Grenade.hs
+1 -1
View File
@@ -97,5 +97,5 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
counterDown it
| _itEffectCounter (_itEffect it) == 0 = it
& itHammer .~ HammerUp
& itEquipPict .~ pictureWeaponOnAim (grenadePic 50)
& itEquipPict .~ pictureWeaponOnAim (\itp -> grenadePic 50)
| otherwise = it & itEffect . itEffectCounter -~ 1
src/Dodge/Item/Weapon/Launcher.hs
+2 -2
View File
@@ -49,10 +49,10 @@ launcher = defaultGun
]
, _wpSpread = 0.02
, _wpRange = 20
, _itFloorPict = launcherPic
, _itFloorPict = \it -> launcherPic
, _itAimingSpeed = 0.2
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim launcherPic
, _itEquipPict = pictureWeaponOnAim $ \it -> launcherPic
, _itHammer = NoHammer
, _itEffect = NoItEffect
, _wpAmmo = defaultShellAmmo
src/Dodge/Layout.hs
-4
View File
@@ -168,7 +168,3 @@ shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a) r
where
(p,a) = last $ _rmLinks r
src/Dodge/Layout/Tree/Annotate.hs
+1 -1
View File
@@ -75,7 +75,7 @@ annoToRoomTree [OrAno as] = do
annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor
annoToRoomTree [CorridorDebug] = pure . Right <$> randomiseOutLinks corridorDebug
annoToRoomTree [DoorAno] = roomThenCorridor door
annoToRoomTree [DoorNumAno i,AirlockAno] = airlock i >>= roomThenCorridor
annoToRoomTree [DoorNumAno i,AirlockAno] = airlock >>= roomThenCorridor
annoToRoomTree [FirstWeapon] = do
branchWP <- branchRectWith weaponRoom
blockedC <- longBlockedCorridor
src/Dodge/LevelGen/Data.hs
+23
View File
@@ -38,8 +38,31 @@ data Placement = Placement
{ _placementSpot :: PlacementSpot
, _idPlacement :: Int -> Maybe Placement
}
sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a pt) (const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a pst) $ const Nothing
jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
sps0 :: PSType -> Placement
sps0 pst = sPS (V2 0 0) 0 pst
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
jspsJ p a pst plm = Just $ Placement (PS p a pst) $ \_ -> Just plm
jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement (PS (V2 0 0) 0 pst)
ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0 pst) (const $ Just plmnt)
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
src/Dodge/LightSources/Fitting.hs
+11 -6
View File
@@ -3,7 +3,6 @@ module Dodge.LightSources.Fitting
import Dodge.LightSources.Lamp
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Placement
import Geometry
mountedLight :: Point2 -> Point3 -> Placement
@@ -15,7 +14,7 @@ mountedLight wallPos lampPos@(V3 x y z)
wallMountL :: Point2 -> Point3 -> Placement
wallMountL wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
where
@@ -25,7 +24,7 @@ wallMountL wallpos lamppos@(V3 x y z)
wallMountJ :: Point2 -> Point3 -> Placement
wallMountJ wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp turn1
<> thinHighBar (z + 5) turn1 turn2
<> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
@@ -39,7 +38,7 @@ wallMountJ wallpos lamppos@(V3 x y z)
wallMountl :: Point2 -> Point3 -> Placement
wallMountl wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
where
@@ -49,14 +48,20 @@ wallMountl wallpos lamppos@(V3 x y z)
wallMountA :: Point2 -> Point3 -> Placement
wallMountA wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ girder (z+10) 20 10 pout wallpos
where
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
mountedLightI :: Float -> Point2 -> Point2 -> Placement
mountedLightI h a b = ps0j (PutLS $ lightAt (V3 x y h) 0)
$ sps0 $ PutForeground $ highPipe (h + 5) a b
where
V2 x y = 0.5 *.* (a +.+ b)
mountedLightV :: Point2 -> Point3 -> Placement
mountedLightV wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
<> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
where
src/Dodge/Placement.hs
-19
View File
@@ -1,19 +0,0 @@
module Dodge.Placement
where
import Geometry
import Dodge.LevelGen.Data
jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
sps0 :: PSType -> Placement
sps0 pst = sPS (V2 0 0) 0 pst
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
jspsJ p a pst plm = Just $ Placement (PS p a pst) $ \_ -> Just plm
jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
place0 :: PSType -> (Int -> Maybe Placement) -> Placement
place0 pst = Placement (PS (V2 0 0) 0 pst)
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -7,5 +7,5 @@ import ShapePicture
floorItemSPic :: FloorItem -> SPic
floorItemSPic flit
= uncurryV translateSPf (_flItPos flit)
$ rotateSP (_flItRot flit) (_itFloorPict (_flIt flit))
$ rotateSP (_flItRot flit) (_itFloorPict (_flIt flit) (_flIt flit))
src/Dodge/Room.hs
+1 -1
View File
@@ -524,5 +524,5 @@ spawnerRoom = do
]
let f (V2 lx _,_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
aRoom <- airlock 0
aRoom <- airlock
return $ treeFromTrunk [Left aRoom] roomWithSpawner
src/Dodge/Room/Airlock.hs
+35 -51
View File
@@ -4,7 +4,9 @@ Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock
where
import Dodge.Room.Data
import Dodge.LightSources.Fitting
import Dodge.Room.Placement
import Dodge.Room.Foreground
import Dodge.Default.Room
import Dodge.Data
import Dodge.LevelGen.Data
@@ -13,7 +15,8 @@ import Dodge.RandomHelp
import Geometry
import Picture
import qualified Data.Map as M
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
import Control.Lens
@@ -39,18 +42,14 @@ airlockOneWay n = defaultRoom
{- |
A passage with a switch that opens forward access while closing backwards access. -}
airlock
:: RandomGen g
=> Int -- ^ Door id
-> State g Room
airlock n = takeOne [airlock0 n,airlock90 n,airlockCrystal n]
airlock :: RandomGen g => State g Room
--airlock = takeOne [airlock0,airlock90,airlockCrystal]
airlock = takeOne [airlock0]
{- |
Straight airlock -}
airlock0
:: Int -- ^ Door id
-> Room
airlock0 n = defaultRoom
airlock0 :: Room
airlock0 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
@@ -60,12 +59,11 @@ airlock0 n = defaultRoom
,(V2 20 45,V2 20 5)
]
, _rmPS =
[sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) 2
,sPS (V2 0 80) 0 $ PutDoubleDoor col cond (V2 1 0) (V2 39 0) 2
,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (V2 (-25) 50) 0 putLamp
[Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 20) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 0) (V2 39 0) 2)
$ sPS (V2 0 80) 0 $ PutDoubleDoor col (cond' btid) (V2 1 0) (V2 39 0) 2
,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70)
,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
]
, _rmBound = [rectNSWE 75 15 0 40]
}
@@ -73,13 +71,12 @@ airlock0 n = defaultRoom
lnks = [(V2 20 95,0)
,(V2 20 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
airlock90
:: Int -- ^ Door id
-> Room
airlock90 n = defaultRoom
:: Room
airlock90 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
, rectNSWE 20 0 20 60
@@ -99,11 +96,9 @@ airlock90 n = defaultRoom
,(V2 40 0,V2 0 40)
]
, _rmPS =
[sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss
,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (V2 60 60) 0 putLamp
[ Placement (PS (V2 120 120) (3 * pi/4) (PutButton $ makeSwitch col red id id))
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
,mountedLightV (V2 20 20) (V3 70 70 50)
]
, _rmBound =
[map toV2 [ (10,10)
@@ -114,45 +109,34 @@ airlock90 n = defaultRoom
]]
}
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
airlockCrystal
:: Int -- ^ Door id
-> Room
airlockCrystal n = defaultRoom
:: Room
airlockCrystal = defaultRoom
{ _rmPolys =
[ rectNSWE 140 0 0 40
, orderPolygon $ map toV2
[(39,20)
,(150,60)
,(150,80)
,(39,120)
]
, orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
]
, _rmLinks =
[(V2 20 130,0)
,(V2 20 0 ,pi)
]
, _rmPath =
[
]
, _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ]
, _rmPath = [ ]
, _rmPS =
[sPS (V2 0 0) 0 $ PutDoor col (not . cond) pss
,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) False))
(over worldState (M.insert (DoorNumOpen n) True))
,crystalLine (V2 0 70) (V2 40 70)
--,sPS (V2 20 40) 0 putLamp
--,sPS (V2 20 100) 0 putLamp
[ Placement (PS (V2 145 70) (pi/2) (PutButton $ makeSwitch col red id id))
$ \btid -> jsps0 $ PutDoor col (cond btid) pss
, crystalLine (V2 0 70) (V2 40 70)
, mountedLightV (V2 150 70) (V3 110 70 70)
]
, _rmBound =
[ ]
}
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
pss :: [(Point2,Point2)]
pss = reverse $ fmap ( (\x -> (V2 50 x,V2 50 (x+50)) ) . fromIntegral)
pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
[20::Int,22..70]
src/Dodge/Room/Corridor.hs
+5 -7
View File
@@ -1,10 +1,11 @@
module Dodge.Room.Corridor
where
import Dodge.Room.Data
import Dodge.Room.Foreground
--import Dodge.Room.Foreground
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.LightSources.Lamp
--import Dodge.LevelGen.Data
--import Dodge.LightSources.Lamp
import Dodge.LightSources.Fitting
import Geometry
import Tile
@@ -16,10 +17,7 @@ corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS =
[sPS (V2 20 40) 0 $ PutLS (lightAt (V3 0 0 50) 0)
,sPS (V2 0 0) 0 $ PutForeground $ highPipe 55 (V2 0 40) (V2 40 40)
]
, _rmPS = [ mountedLightI 50 (V2 0 40) (V2 40 40) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [makeTileFromPoly poly 2]
}
src/Dodge/Room/LongDoor.hs
+2 -3
View File
@@ -16,7 +16,6 @@ import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSources.Lamp
import Dodge.Placement
import Picture
import Geometry
@@ -42,8 +41,8 @@ twinSlowDoorRoom w h x = defaultRoom
, _rmPS =
[ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ place0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ ps0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> Just $ ps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
]
, _rmBound = ps
src/Dodge/Room/NoNeedWeapon.hs
+4 -5
View File
@@ -29,11 +29,10 @@ centerVaultExplosiveExit
centerVaultExplosiveExit = do
cr <- takeOne [miniGunCrit, autoCrit]
let extraPS =
[sPS (V2 0 175) 0 $ PutCrit explosiveBarrel
,sPS (V2 5 195) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 200) 0 $ PutCrit explosiveBarrel
,sPS (V2 (-4) 195) 0 $ PutCrit explosiveBarrel
[sPS (V2 0 110) 0 $ PutCrit explosiveBarrel
,sPS (V2 5 115) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
r <- centerVaultRoom 200 200 50 <&> rmPS %~ (extraPS ++)
r <- centerVaultRoom 120 120 50 <&> rmPS %~ (extraPS ++)
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
src/Dodge/Room/Placement.hs
+10
View File
@@ -4,6 +4,7 @@ module Dodge.Room.Placement
import Dodge.Data
import Dodge.Default.Wall
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Room.Data
import Dodge.Creature.Inanimate
import Picture
@@ -11,6 +12,7 @@ import Geometry
import Data.List
import Control.Lens
import qualified Data.IntMap.Strict as IM
putColorLamp :: Point3 -> PSType
putColorLamp col = PutCrit (colorLamp col 90)
@@ -178,3 +180,11 @@ putBlockN a x b y = [ blockLine (V2 a b) (V2 a y)
, blockLine (V2 x b) (V2 a b)
, blockLine (V2 x y) (V2 x b)
]
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = Placement (PS btpos btrot $ PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSingleDoor col (cond btid) dra drc 2)
$ sps0 (PutSingleDoor col (cond btid) drb drc 2)
where
drc = 0.5 *.* (dra +.+ drb)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
src/Dodge/Room/Procedural.hs
+8 -6
View File
@@ -15,7 +15,6 @@ import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
import Dodge.Room.Path
import Dodge.Placement
import Dodge.Default.Room
import Dodge.Item.Consumable
import Dodge.Item.Equipment
@@ -28,6 +27,7 @@ import Dodge.LightSources.Fitting
import Dodge.Creature
--import Dodge.Default
import Geometry
import Geometry.Vector3D
import Picture
import Data.Tile
@@ -235,12 +235,14 @@ centerVaultRoom w h d = do
,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
-- ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
-- ,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
-- ,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
-- ,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
]
++ map (\a -> mountedLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concat (map (\r -> map (shiftPSBy (V2 0 0,r)) $ theDoor)
[0,pi/2,pi,3*pi/2])
, _rmBound = [rectNSWE h (-h) (-w) w]
src/Dodge/Room/RoadBlock.hs
+5 -3
View File
@@ -13,6 +13,7 @@ import Dodge.LevelGen.Data
--import Dodge.RandomHelp
import Dodge.Creature
import Dodge.Layout.Tree.Polymorphic
import Dodge.LightSources.Fitting
import Data.Tree
import Control.Monad.State
@@ -71,8 +72,9 @@ longBlockedCorridor = do
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do
r <- state $ randomR (0,pi)
let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
let plmnts =
[sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
$ reverse $ rectNSWE 10 (-10) (-10) 10
,sPS (V2 20 15) 0 putLamp
]
,mountedLightI 55 (V2 0 15) (V2 40 15)
]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
src/Geometry/Vector3D.hs
+6
View File
@@ -49,6 +49,12 @@ rotate3 a (V3 x y z) = V3 x' y' z
where
(V2 x' y') = rotateV a (V2 x y)
rotate3z :: Float -> Point3 -> Point3
{-# INLINE rotate3z #-}
rotate3z a (V3 x y z) = V3 x' y' z
where
(V2 x' y') = rotateV a (V2 x y)
rotate3x :: Float -> Point3 -> Point3
{-# INLINE rotate3x #-}
rotate3x a (V3 x y z) = V3 x y' z'