Fix explosion damage
This commit is contained in:
@@ -1,11 +1,21 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Room.Foreground where
|
||||
module Dodge.Room.Foreground
|
||||
( thinHighBar
|
||||
, putShape
|
||||
, girder
|
||||
, girderZ
|
||||
, girderV
|
||||
, girderV'
|
||||
, barPP
|
||||
, highDiagonalMesh
|
||||
, highMesh
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Picture
|
||||
import Geometry
|
||||
import Shape
|
||||
import Quaternion
|
||||
--import Bound
|
||||
import Bound
|
||||
|
||||
--import Dodge.Data.ForegroundShape
|
||||
import Dodge.Default.Foreground
|
||||
@@ -13,8 +23,16 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Control.Lens
|
||||
import ShapePicture
|
||||
--import Streaming
|
||||
--import qualified Streaming.Prelude as S
|
||||
import Streaming
|
||||
import qualified Streaming.Prelude as S
|
||||
|
||||
highMesh
|
||||
:: Point2
|
||||
-> Point2
|
||||
-> Float -- ^ width
|
||||
-> Picture
|
||||
highMesh pa pb w = highDiagonalMesh pa pb w 20
|
||||
<> highDiagonalMesh (pa +.+ w *.* normalizeV (vNormal (pb -.- pa))) pa (dist pa pb) 20
|
||||
|
||||
highDiagonalMesh
|
||||
:: Point2
|
||||
@@ -22,10 +40,10 @@ highDiagonalMesh
|
||||
-> Float -- ^ width
|
||||
-> Float -- ^ vertical distance between lines
|
||||
-> Picture
|
||||
highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
|
||||
map (thickLine 3 . tflat2) (diagonalLinesRect pb pa w d (3*pi/4))
|
||||
highDiagonalMesh pa pb w d = setDepth 100 $ pictures $
|
||||
map (thickLine 2 . tflat2) (diagonalLinesRect pb pa w d (3*pi/4))
|
||||
++
|
||||
map (thickLine 3 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
|
||||
map (thickLine 2 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
|
||||
where
|
||||
pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
|
||||
h = dist pa pb
|
||||
@@ -54,14 +72,14 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
|
||||
thinHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
thinHighBar = highBar 3
|
||||
|
||||
thinHighBarLoop :: Float -> [Point2] -> Shape
|
||||
thinHighBarLoop h = foldMap (uncurry $ thinHighBar h) . loopPairs
|
||||
--thinHighBarLoop :: Float -> [Point2] -> Shape
|
||||
--thinHighBarLoop h = foldMap (uncurry $ thinHighBar h) . loopPairs
|
||||
|
||||
thinHighBarChain :: Float -> [Point2] -> Shape
|
||||
thinHighBarChain h = foldMap (uncurry $ thinHighBar h) . chainPairs
|
||||
--thinHighBarChain :: Float -> [Point2] -> Shape
|
||||
--thinHighBarChain h = foldMap (uncurry $ thinHighBar h) . chainPairs
|
||||
|
||||
thickHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
thickHighBar = highBar 5
|
||||
--thickHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
--thickHighBar = highBar 5
|
||||
|
||||
highBar :: Float -> Float -> Point2 -> Point2 -> Shape
|
||||
highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thickness
|
||||
@@ -69,13 +87,13 @@ highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thick
|
||||
where
|
||||
n = 0.5 * thickness *.* normalizeV (vNormal (y -.- x))
|
||||
|
||||
highPipe :: Float -> Point2 -> Point2 -> Shape
|
||||
highPipe h x y = colorSH orange $ prismPoly
|
||||
(map (addZ (h + 5)) [x +.+ n2, y +.+ n2, y -.- n2, x -.- n2])
|
||||
(map (addZ h) [x +.+ n, y +.+ n, y -.- n, x -.- n] )
|
||||
where
|
||||
n2 = 1.25 *.* normalizeV (vNormal (y -.- x))
|
||||
n = 2.5 *.* normalizeV (vNormal (y -.- x))
|
||||
--highPipe :: Float -> Point2 -> Point2 -> Shape
|
||||
--highPipe h x y = colorSH orange $ prismPoly
|
||||
-- (map (addZ (h + 5)) [x +.+ n2, y +.+ n2, y -.- n2, x -.- n2])
|
||||
-- (map (addZ h) [x +.+ n, y +.+ n, y -.- n, x -.- n] )
|
||||
-- where
|
||||
-- n2 = 1.25 *.* normalizeV (vNormal (y -.- x))
|
||||
-- n = 2.5 *.* normalizeV (vNormal (y -.- x))
|
||||
|
||||
girderZ
|
||||
:: Float -- ^ height
|
||||
@@ -96,43 +114,20 @@ girderZ h d w x y = colorSH red $ mconcat $
|
||||
ps = divideLineExact d xb yb
|
||||
qs = tail $ divideLineExact d xt yt
|
||||
|
||||
girderVCapL
|
||||
:: Float -- ^ "cap" size
|
||||
-> Float -- ^ height
|
||||
-> Float -- ^ distance between cross bars
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderVCapL csize h d w x y = thinHighBar h (x -.- n) (x +.+ n)
|
||||
<> girderV h d w x y
|
||||
where
|
||||
n = csize *.* vNormal (normalizeV (x -.- y))
|
||||
|
||||
girderVCapLR
|
||||
:: Float -- ^ "cap" size
|
||||
-> Float -- ^ height
|
||||
-> Float -- ^ distance between cross bars
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderVCapLR csize h d w x y = thinHighBar h (x -.- n) (x +.+ n)
|
||||
<> thinHighBar h (y -.- n) (y +.+ n)
|
||||
<> girderV h d w x y
|
||||
where
|
||||
n = csize *.* vNormal (normalizeV (x -.- y))
|
||||
|
||||
putShape :: Shape -> PSType
|
||||
putShape sh = PutForeground $ defaultForeground
|
||||
& fsPos .~ m
|
||||
& fsRad .~ radBounds bnds
|
||||
& fsSPic .~ noPic (uncurryV translateSHf (-m) sh)
|
||||
where
|
||||
bnds = (0,0,0,0) -- shapeBounds sh
|
||||
bnds = shapeBounds sh
|
||||
m = midBounds bnds
|
||||
|
||||
--shapePoints :: Shape -> Stream (Of Point2) Identity ()
|
||||
--shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
|
||||
shapePoints :: Shape -> Stream (Of Point2) Identity ()
|
||||
shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
|
||||
|
||||
--shapeBounds :: Shape -> (Float,Float,Float,Float)
|
||||
--shapeBounds = fromMaybe (0,0,0,0) . boundPoints . shapePoints
|
||||
shapeBounds :: Shape -> (Float,Float,Float,Float)
|
||||
shapeBounds = fromMaybe (0,0,0,0) . boundPoints . shapePoints
|
||||
|
||||
midBounds :: (Float,Float,Float,Float) -> Point2
|
||||
midBounds (n,s,e,w) = V2 ((n + s)/2) ((e + w)/2)
|
||||
@@ -200,9 +195,6 @@ girder h d w x y = mconcat $
|
||||
ps = divideLineExact d xb yb
|
||||
qs = divideLineExact d xt yt
|
||||
|
||||
robotArm :: Shape
|
||||
robotArm = undefined
|
||||
|
||||
barPP :: Float -> Point3 -> Point3 -> Shape
|
||||
barPP w a b
|
||||
| a == b = mempty
|
||||
@@ -212,17 +204,17 @@ barPP w a b
|
||||
where
|
||||
z1 = b -.-.- a
|
||||
|
||||
pipePP :: Float -> Point3 -> Point3 -> Shape
|
||||
pipePP w a b = prismPoly
|
||||
(map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
|
||||
(map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
|
||||
where
|
||||
z1 = b -.-.- a
|
||||
--pipePP :: Float -> Point3 -> Point3 -> Shape
|
||||
--pipePP w a b = prismPoly
|
||||
-- (map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
|
||||
-- (map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
|
||||
-- where
|
||||
-- z1 = b -.-.- a
|
||||
|
||||
tankTopPipe :: Shape
|
||||
tankTopPipe = colorSH orange $
|
||||
upperPrismPoly 31 (polyCirc 4 20)
|
||||
<> prismPoly
|
||||
(map (addZ 41) $ polyCirc 4 5)
|
||||
(map (addZ 31) $ polyCirc 4 20)
|
||||
-- <> pipePP 5 (V3 0 0 51) (V3 0 0 41)
|
||||
--tankTopPipe :: Shape
|
||||
--tankTopPipe = colorSH orange $
|
||||
-- upperPrismPoly 31 (polyCirc 4 20)
|
||||
-- <> prismPoly
|
||||
-- (map (addZ 41) $ polyCirc 4 5)
|
||||
-- (map (addZ 31) $ polyCirc 4 20)
|
||||
---- <> pipePP 5 (V3 0 0 51) (V3 0 0 41)
|
||||
|
||||
@@ -17,6 +17,7 @@ import Dodge.RoomLink
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Creature
|
||||
import Dodge.Room.Pillar
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Girder
|
||||
import Dodge.Room.Modify.Girder
|
||||
import Dodge.LevelGen.Data
|
||||
@@ -47,6 +48,7 @@ roomC w h = do
|
||||
. setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
|
||||
)
|
||||
& rmPmnts .:~ wallf (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
& rmPmnts .:~ sps0 (PutDecoration (highMesh (V2 0 0) (V2 0 h) 50))
|
||||
& rmRandPSs .~ [farside]
|
||||
)
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user