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

Implement randomised markings on sensors

Browse Source
This commit is contained in:
justin
2022-03-13 19:59:46 +00:00
parent 06a501ff88
commit 1b6f11709c
16 changed files with 169 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Color.hs
+24 -2
View File
@@ -1,7 +1,10 @@
module Color
where
module Color where
import Geometry
data PaletteColor = Red | Green | Blue | Yellow | Cyan
| Magenta | Rose | Violet | Azure | Aquamarine | Chartreuse | Orange | White | Black
deriving (Eq,Ord,Enum,Show)
type RGBA = Point4
type Color = Point4
@@ -40,6 +43,24 @@ black = V4 0 0 0 1
{-# INLINE white #-}
{-# INLINE black #-}
paletteToColor :: PaletteColor -> Color
{-# INLINE paletteToColor #-}
paletteToColor pc = case pc of
Red -> red
Green -> green
Blue -> blue
Yellow -> yellow
Cyan -> cyan
Magenta -> magenta
Rose -> rose
Violet -> violet
Azure -> azure
Aquamarine -> aquamarine
Chartreuse -> chartreuse
Orange -> orange
White -> white
Black -> black
mixColors :: Float -> Float -> Color -> Color -> Color
{-# INLINE mixColors #-}
mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) =
@@ -74,6 +95,7 @@ greyN :: Float -> Color
greyN x = toV4 (x,x,x,1)
numColor :: Int -> Color
{-# INLINE numColor #-}
numColor 0 = toV4 (1,0,0,1)
numColor 1 = toV4 (0,1,0,1)
numColor 2 = toV4 (0,0,1,1)
src/Dodge/Creature/Inanimate.hs
+4 -4
View File
@@ -23,10 +23,10 @@ import Geometry
--import Geometry.Vector3D
import Shape
import Dodge.SoundLogic
import LensHelp
import System.Random
import Data.List
import Control.Lens
barrel :: Creature
barrel = defaultInanimate
@@ -89,7 +89,7 @@ damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where
(pierceDam,otherDam) = partition isPierce ds
isPierce (Damage {_dmType = Piercing{}}) = True
isPierce Damage{_dmType = Piercing{}} = True
isPierce _ = False
damToExpBarrel' :: Damage -> Creature -> Creature
@@ -98,8 +98,8 @@ damToExpBarrel' dm cr = case _dmType dm of
$ over crHP (\hp -> hp - div amount 200) cr
PoisonDam -> cr
SparkDam -> cr
PushDam -> cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* (_dePushBack $ _dmEffect dm))
dt -> cr Control.Lens.& crHP -~ amount
PushDam -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
_ -> cr LensHelp.& crHP -~ amount
where
amount = _dmAmount dm
int = _dmAt dm
src/Dodge/Data/DamageType.hs
+1
View File
@@ -25,6 +25,7 @@ data DamageType = Piercing
| PoisonDam
deriving (Eq,Ord,Show)
-- this should possibly be pushed into the damage type
data DamageEffect
= PushDamage
{ _dePush :: Float
src/Dodge/Floor.hs
+1 -1
View File
@@ -12,7 +12,7 @@ import Dodge.Data.DamageType
--import Dodge.Placement.Instance.Button
import Dodge.Tree
import Dodge.Annotation
import Dodge.Placement.Instance.Sensor
--import Dodge.Placement.Instance.Sensor
--import Dodge.Creature
--import Dodge.LevelGen.Data
--import Dodge.LevelGen.Switch
src/Dodge/Item/Equipment.hs
+1 -1
View File
@@ -122,7 +122,7 @@ shieldWallDamage :: Damage -> Wall -> Int -> World -> World
shieldWallDamage dm wl crid w = case _dmType dm of
Lasering ->
w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
d | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
_ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
_ -> w
where
df = _dmFrom dm
src/Dodge/LevelGen.hs
+1 -1
View File
@@ -9,7 +9,7 @@ import Dodge.Initialisation
--import Dodge.RandomHelp
import Dodge.LevelGen.Data
import Dodge.Tree
import Dodge.LevelGen.LevelStructure
--import Dodge.LevelGen.LevelStructure
import Data.Tree
import System.Random
src/Dodge/LevelGen/Data.hs
+22 -1
View File
@@ -4,10 +4,12 @@ module Dodge.LevelGen.Data where
import Dodge.Data
import Picture
import Geometry
--import Color
import Shape.Data
import Data.Tile
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Control.Lens
import Control.Monad.State
import System.Random
@@ -16,7 +18,7 @@ import qualified Data.IntMap.Strict as IM
--import Data.Bifunctor
data PSType = PutCrit {_unPutCrit :: Creature}
| PutMachine Color [Point2] Machine
| PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine }
| PutLS LightSource
| PutButton Button
| PutProp Prop
@@ -34,6 +36,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
| PutShape Shape
| PutWorldUpdate (PlacementSpot -> World -> World)
| PutNothing
| PutUsingGenParams (GenWorld -> (GenWorld,PSType))
| PutID { _putID :: Int}
-- maybe there is a monadic implementation of this?
-- add room effect for any placement spot?
@@ -56,6 +59,7 @@ data Placement
, _plMID :: Maybe Int
, _plIDCont :: Placement -> Maybe Placement
}
| PlacementGenUpdate (GenParams -> Placement -> (GenParams, Placement)) Placement
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
| PickOnePlacement Int Placement
@@ -152,6 +156,20 @@ data RoomPosType
| RoomPosOffPath
| RoomPosExLink
deriving (Eq,Ord,Show)
data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration
| ThreeLineDecoration
deriving (Eq,Ord,Enum,Show)
newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
}
data GenWorld = GenWorld
{ _gWorld :: World
, _gPlacements :: IM.IntMap [(Placement,Int)]
, _gRooms :: IM.IntMap Room
, _gParams :: GenParams
}
makeLenses ''Room
makeLenses ''PSType
@@ -161,6 +179,8 @@ makeLenses ''RoomLink
makeLenses ''RoomPos
makeLenses ''RoomPosType
makeLenses ''RPLinkStatus
makeLenses ''GenWorld
makeLenses ''GenParams
spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing)
@@ -231,6 +251,7 @@ addPlmnt pl pl2 = case pl2 of
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
PickOnePlacement {} -> error "not written how to combine PickOnePlacement with others yet"
PlacementGenUpdate {} -> error "not written how to combine PlacementGenUpdate with others yet"
where
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'
src/Dodge/LevelGen/LevelStructure.hs
+19 -10
View File
@@ -1,24 +1,33 @@
{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.LevelGen.LevelStructure where
module Dodge.LevelGen.LevelStructure
( module Dodge.LevelGen.Data
, worldToGenWorld
) where
import Dodge.LevelGen.Data
--import Dodge.Tree.Compose.Data
import Dodge.Data
import Dodge.RandomHelp
import Color
--import Data.Tree
import qualified Data.IntMap.Strict as IM
import Control.Lens
--import System.Random
import qualified Data.Map.Strict as M
--import Control.Lens
import Control.Monad.State
import System.Random
data GenWorld = GenWorld
{ _gWorld :: World
, _gPlacements :: IM.IntMap [(Placement,Int)]
, _gRooms :: IM.IntMap Room
}
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
worldToGenWorld rms w = GenWorld
{ _gWorld = w
, _gPlacements = IM.empty
, _gRooms = rms
, _gParams = evalState generateGenParams (_randGen w)
}
makeLenses ''GenWorld
generateGenParams :: RandomGen g => State g GenParams
generateGenParams = do
cols <- shuffle [Red .. Orange]
shps <- shuffle [PlusDecoration ..]
return . GenParams . M.fromList . zip [Flaming,Lasering,Electrical]
$ zip cols shps
src/Dodge/Particle/Bullet/HitEffect.hs
-5
View File
@@ -63,11 +63,6 @@ bulPenCr' bt p cr w = w
& bulletHitSound ep
& creatures . ix cid . crState . crDamage .++~
damageGamut 50 50 d1 sp p ep
-- [Damage Piercing 50 sp p ep NoDamageEffect
-- ,Damage Blunt 50 sp p ep NoDamageEffect
-- ,Damage TorqueDam 1 sp p ep $ TorqueDamage d1
-- ,Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
-- ]
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
src/Dodge/Placement/Instance/Sensor.hs
+12 -8
View File
@@ -7,10 +7,12 @@ import Dodge.LightSource
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
import Dodge.Placement.TopDecoration
import Geometry
import ShapePicture
import Shape
import qualified Data.Map.Strict as M
import Control.Lens
import Data.Either
@@ -19,14 +21,13 @@ damageSensor
-> Float
-> (Machine -> World -> World)
-> PlacementSpot -> Placement
damageSensor damF wdth upf ps = pContID ps (PutLS theLS)
$ \lsid -> Just $ spNoID ps $ PutMachine yellow (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic wdth
, _mcUpdate = \mc -> upf mc . sensorUpdate damF mc
damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
$ \lsid -> Just $ spNoID ps $ PutUsingGenParams
$ \gw -> (,) gw $ PutMachine yellow (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic wdth $ _sensorCoding (_gParams gw) M.! dt
, _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
, _mcLSs = [lsid]
}
where
theLS = lsPosCol (V3 0 0 30) 0.1
lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor Lasering
@@ -51,6 +52,9 @@ damageUsing dt dm
| _dmType dm == dt = Left $ _dmAmount dm
| otherwise = Right 0
sensorSPic :: Float -> Machine -> SPic
sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
sensorSPic wdth (pc,ds) _ = ( (colorSH yellow $ upperPrismPoly 25 (square wdth))
<> decorationToShape ds wdth wdth 25 col col
, mempty )
where
col = paletteToColor pc
src/Dodge/Placement/Instance/Tank.hs
+10 -56
View File
@@ -1,14 +1,23 @@
module Dodge.Placement.Instance.Tank where
module Dodge.Placement.Instance.Tank
( tankSquareDec
, roundTank
, roundTankCross
) where
import Dodge.Data
--import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Default.Wall
--import Dodge.Placement.TopDecoration
import Geometry
import Shape
import Color
--import Quaternion
tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape)
-> Color -> Color -> Placement
tankSquareDec dec = tankShape (square 20) (dec 20 20 31)
tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
tankShape baseshape facade col col' = ps0jPushPS
(PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
@@ -25,58 +34,3 @@ roundTankCross :: Color -> Color -> Placement
roundTankCross = tankShape (polyCirc 4 20)
$ \_ c -> colorSH c $ thinHighBar 31 (V2 20 0) (V2 (-20) 0)
<> thinHighBar 31 (V2 0 20) (V2 0 (-20))
tankRectCross :: Float -> Float -> Color -> Color -> Placement
tankRectCross = tankRectDecorate $ \ w h _ c -> colorSH c $
thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
tankSquareCross :: Color -> Color -> Placement
tankSquareCross = tankRectCross 20 20
tankRectDecorate :: (Float -> Float -> Color -> Color -> Shape)
-> Float -> Float -> Color -> Color -> Placement
tankRectDecorate f w h = tankShape (rectWH w h) (f w h)
tankRect :: Float -> Float -> Color -> Color -> Placement
tankRect = tankRectDecorate g
where
g w h _ col = colorSH col $ foldMap f
[(w',-w',h',h')
,(w',-w',-h',-h')
,(w',w',h',-h')
,(-w',-w',h',-h')
]
where
w' = w - 1.5
h' = h - 1.5
f (a,c,b,d) = thinHighBar 31 (V2 a b) (V2 c d)
tankSquare :: Color -> Color -> Placement
tankSquare = tankRect 20 20
tankRectEmboss :: Float -> Float -> Color -> Color -> Placement
tankRectEmboss = tankRectDecorate f
where
f w h _ c = embossingR
<> rotateSH pi embossingR
<> colorSH c (thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0))
where
w' = 0.3 * w
embossingR = colorSH c $ prismPoly
[V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
[V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
tankSquareEmboss :: Color -> Color -> Placement
tankSquareEmboss = tankRectEmboss 20 20
tankRectEmboss4 :: Float -> Float -> Color -> Color -> Placement
tankRectEmboss4 = tankRectDecorate g
where
g w h _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
where
f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
tankSquareEmboss4 :: Color -> Color -> Placement
tankSquareEmboss4 = tankRectEmboss4 20 20
src/Dodge/Placement/PlaceSpot.hs
+5 -1
View File
@@ -11,7 +11,7 @@ import Dodge.Data
import Dodge.Path
import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Dodge.Default.Wall
import Dodge.ShiftPoint
--import Dodge.RandomHelp
@@ -39,6 +39,8 @@ placeSpot (w,rm) plmnt = case plmnt of
PlacementUsingPos p subpl -> placeSpot (w,rm) (subpl (shiftPoint3By shift p))
RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
PickOnePlacement i pl -> ((placePickOne i pl rm w, rm), [])
PlacementGenUpdate f pl -> let (gp,pl') = f (_gParams w) pl
in placeSpot (w & gParams .~ gp,rm) pl'
where
shift = _rmShift rm
@@ -109,6 +111,8 @@ placeSpotID ps pt w = case pt of
PutNothing -> (0,w)
PutID i -> (i, w)
PutWorldUpdate f -> (0,w & gWorld %~ f ps)
PutUsingGenParams f -> let (w',pt') = f w
in placeSpotID ps pt' w'
where
p@(V2 px py) = _psPos ps
p' = V3 px py 0
src/Dodge/Placement/Shift.hs
+1
View File
@@ -20,3 +20,4 @@ shiftPlacement shift plmnt = case plmnt of
(fmap (shiftPlacement shift) f)
RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
PickOnePlacement i pl -> PickOnePlacement i (shiftPlacement shift pl)
PlacementGenUpdate f pl -> PlacementGenUpdate f (shiftPlacement shift pl)
src/Dodge/Placement/TopDecoration.hs
+62
View File
@@ -0,0 +1,62 @@
module Dodge.Placement.TopDecoration where
import Dodge.Room.Foreground
import Dodge.LevelGen.Data
import Shape
import Geometry
import Color
decorationToShape :: DecorationShape
-> Float -> Float -> Float -> Color -> Color -> Shape
decorationToShape dec = case dec of
PlusDecoration -> plusDecoration
SquareDecoration -> squareDecoration
CircleDecoration -> circleDecoration
ThreeLineDecoration -> threeLineDecoration
midBarDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
midBarDecoration w h z _ c = embossingR
<> rotateSH pi embossingR
<> colorSH c (thinHighBar (z + 7) (V2 (-0.3*w) 0) (V2 (0.3*w) 0))
where
w' = 0.3 * w
embossingR = colorSH c $ prismPoly
[V3 w h z,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) z]
[V3 w' h z,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) z]
fourEmbossDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
fourEmbossDecoration w h z _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
where
f (a,b) = translateSH (V3 (a/2) (b/2) z) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
plusDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
plusDecoration w h z _ c = colorSH c $ thinHighBar z (V2 w 0) (V2 (-w) 0)
<> thinHighBar z (V2 0 h) (V2 0 (-h))
squareDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
squareDecoration w h z _ col = colorSH col $ foldMap f
[(w',-w',h',h')
,(w',-w',-h',-h')
,(w',w',h',-h')
,(-w',-w',h',-h')
]
where
w' = w - 1.5
h' = h - 1.5
f (a,c,b,d) = thinHighBar z (V2 a b) (V2 c d)
circleDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
circleDecoration w _ z _ c = colorSH c $ foldMap toprail (take 8 [0,pi/4..])
where
toprail a = rotateSH a $ thinHighBar z (V2 0 w) (rotateV (pi/4) $ V2 0 w)
threeLineDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
threeLineDecoration w h z _ col = colorSH col $ foldMap f
[(w',-w',h',h')
,(w',-w',0,0)
,(w',-w',-h',-h')
]
where
w' = w - 1.5
h' = h - 1.5
f (a,c,b,d) = thinHighBar z (V2 a b) (V2 c d)
src/Dodge/Room/SensorDoor.hs
-1
View File
@@ -38,7 +38,6 @@ sensorRoom senseType n = do
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
src/Dodge/Room/Tanks.hs
+6 -4
View File
@@ -6,11 +6,13 @@ import Dodge.Room.Procedural
import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.Placement.TopDecoration
import Dodge.PlacementSpot
--import Padding
import Color
--import Shape
import LensHelp
--import Geometry
--import Data.Maybe
--import Data.Tree
@@ -20,12 +22,12 @@ import qualified Data.Set as S
randomTank :: RandomGen g => State g Placement
randomTank = takeOne $ map (\f -> f (dim orange) orange)
[ tankSquareEmboss4
, tankSquareEmboss
, tankSquare
[ tankSquareDec fourEmbossDecoration
, tankSquareDec midBarDecoration
, tankSquareDec squareDecoration
, roundTank
, roundTankCross
, tankSquareCross
, tankSquareDec plusDecoration
]
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room