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

Add tank furniture, stop autorotate when aiming

Browse Source
This commit is contained in:
justin
2021-10-05 22:57:54 +01:00
parent cab8c25610
commit d46de1ca80
17 changed files with 186 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Boss.hs
+5 -6
View File
@@ -5,6 +5,7 @@ module Dodge.Room.Boss
where
import Dodge.Data
import Dodge.Default.Room
import Dodge.LightSources.Fitting
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Placement
@@ -97,10 +98,8 @@ roomCross x y = defaultRoom
]
, _rmPath = []
, _rmPS =
[sPS (V2 x 0) 0 putLamp
,sPS (-V2 x 0) 0 putLamp
,sPS (V2 0 x) 0 putLamp
,sPS (V2 0 (-x)) 0 putLamp
[ mountedLightI 70 (V2 (x+5) x) (V2 (x+5) (-x))
, mountedLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x))
]
, _rmBound =
[rectNSWE y (-y) (-x) x
@@ -123,7 +122,7 @@ roomShuriken x y =
{ _rmPolys = ps
, _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)]
, _rmPath = []
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmPS = [mountedLight (V2 x x) (V3 (x-20) x 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
@@ -147,7 +146,7 @@ roomTwistCross x y z =
{ _rmPolys = ps
, _rmLinks = [(V2 z (y-20), pi/2)]
, _rmPath = []
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmPS = [mountedLight (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
src/Dodge/Room/Foreground.hs
+16
View File
@@ -127,3 +127,19 @@ girder h d w x y = colorSH red $ mconcat $
yt = y -.- n
ps = divideLineExact d xb yb
qs = divideLineExact d xt yt
robotArm :: Shape
robotArm = undefined
pipePP :: Float -> Point3 -> Point3 -> Shape
pipePP w a b = prismPoly
(map ((+.+.+ a) . addZ 0) $ polyCirc 4 w)
(map ((+.+.+ b) . addZ 0) $ polyCirc 4 w)
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)
src/Dodge/Room/Furniture.hs
+97
View File
@@ -0,0 +1,97 @@
module Dodge.Room.Furniture
where
import Dodge.Data
import Dodge.LevelGen
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Default.Wall
import Geometry
import Shape
import Color
roundTankTopRail :: Color -> Float -> Float -> Placement
roundTankTopRail col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi/4) $ V2 0 20)
thecircle = polyCirc 4 20
roundTankCross :: Color -> Float -> Float -> Placement
roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
<> thinHighBar 31 (V2 0 20) (V2 0 (-20))
)
$ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
thecircle = polyCirc 4 20
tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
tankSquareCross :: Color -> Float -> Float -> Placement
tankSquareCross = tankRectCross 20 20
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
w' = w - 1.5
h' = h - 1.5
f (a,b,c,d) = thinHighBar 31 (V2 a b) (V2 c d)
tankSquare :: Color -> Float -> Float -> Placement
tankSquare = tankRect 20 20
tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> embossingR
<> rotateSH pi embossingR
<> thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0)
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
w' = 0.3 * w
therect = rectWH w h
embossingR = 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 -> Float -> Float -> Placement
tankSquareEmboss = tankRectEmboss 20 20
tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
<> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
where
therect = rectWH w h
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 -> Float -> Float -> Placement
tankSquareEmboss4 = tankRectEmboss4 20 20
src/Dodge/Room/Placement.hs
+4 -2
View File
@@ -91,7 +91,7 @@ windowLineType :: Point2 -> Point2 -> PSType
windowLineType = PutLineBlock baseWindowPane 8 8
baseBlockPane :: Wall
baseBlockPane = Block
baseBlockPane = defaultBlock
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.5
@@ -102,9 +102,10 @@ baseBlockPane = Block
, _blVisible = True
, _blShadows = []
, _blDegrades = [20,20]
, _wlDraw = True
}
baseWindowPane :: Wall
baseWindowPane = Block
baseWindowPane = defaultBlock
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = withAlpha 0.2 cyan
@@ -115,6 +116,7 @@ baseWindowPane = Block
, _blVisible = True
, _blShadows = []
, _blDegrades = [5,5]
, _wlDraw = True
}
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
replacePutID
src/Dodge/Room/Procedural.hs
+1 -1
View File
@@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPS = [wallMountL (V2 (x/2) 0) (V3 (x/2) 40 50)]
, _rmPS = [mountLightA (V2 (x/2) 0) (V3 (x/2) 40 50)]
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile
{ _tilePoly = rectNSWE y 0 0 x
src/Dodge/Room/RoadBlock.hs
+1
View File
@@ -43,6 +43,7 @@ litCorridor90 = do
]
, _rmPS =
[ sPS (V2 20 (h-5)) 0 putLamp
, mountedLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h))
, windowLine (V2 0 (h-20)) (V2 40 (h-20))
, sPS (V2 (-50) (h-85)) 0 putLamp
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
src/Dodge/Room/Start.hs
+7 -4
View File
@@ -4,13 +4,13 @@ import Dodge.Room.Data
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
--import Dodge.Room.Placement
import Dodge.Room.Foreground
import Dodge.Room.Furniture
import Dodge.Layout.Tree.Polymorphic
import Dodge.LevelGen.Data
import Dodge.LightSources.Fitting
--import Picture
import Geometry.Data
import Color
import Data.Tree
import Control.Monad.State
@@ -18,7 +18,8 @@ import Control.Lens
import System.Random
rezBox :: Room
rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 & rmPS .~ []
rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1
& rmPS .~ [ mountColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = do
@@ -32,6 +33,8 @@ startRoom = do
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPS .~
[ fground
, wallMountJ (V2 0 (h/3)) (V3 40 (h/3) 70)
, mountedLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquareEmboss4 (dim orange) 50 50
]
)
src/Dodge/Room/Treasure.hs
+2 -3
View File
@@ -9,6 +9,7 @@ import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.LightSources.Fitting
import Geometry
--import Data.List
@@ -32,9 +33,7 @@ triLootRoom w h = pure $ defaultRoom
[sPS (V2 (15-w) 15 ) 0 $ PutID 0
,sPS (V2 (w-15) 15 ) pi $ PutID 0
,sPS (V2 0 (h-35)) 0 $ PutID 2
,sPS (V2 ( -5) (h-10)) 0 putLamp
,sPS (V2 5 (h-10)) 0 putLamp
,sPS (V2 0 (h-15)) 0 putLamp
,mountedLightV (V2 0 (h-20)) (V3 0 (h-80) 70)
,sPS (V2 0 ( -60)) 0 putLamp
]
, _rmBound = [tri , base]