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/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)