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