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/Data.hs
+4 -10
View File
@@ -554,16 +554,8 @@ data Wall
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _wlPathable :: Bool
}
| BlockAutoDoor
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
, _wlIsSeeThrough :: Bool
, _wlDraw :: Bool
, _wlRotateTo :: Bool
}
| Block
{ _wlLine :: (Point2,Point2)
@@ -576,6 +568,8 @@ data Wall
, _blVisible :: Bool
, _blDegrades :: [Int]
, _blShadows :: [Int]
, _wlDraw :: Bool
, _wlRotateTo :: Bool
}
data ForceField = FF
{ _ffLine :: [Point2] , _ffID :: Int
src/Dodge/Default/Wall.hs
+19 -1
View File
@@ -12,10 +12,28 @@ defaultWall = Wall
, _wlSeen = False
, _wlIsSeeThrough = False
, _wlPathable = False
, _wlDraw = True
, _wlRotateTo = True
}
defaultBlock :: Wall
defaultBlock = Block
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.5
, _wlSeen = False
, _blIDs = []
, _blHP = 5
, _wlIsSeeThrough = False
, _blVisible = True
, _blShadows = []
, _blDegrades = [20,20]
, _wlDraw = True
, _wlRotateTo = True
}
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
defaultCrystalWall = Wall
defaultCrystalWall = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = withAlpha 0.5 aquamarine
src/Dodge/Floor.hs
+2 -2
View File
@@ -81,8 +81,8 @@ initialRoomTree = do
--- ,[DoorNumAno 0,AirlockAno]]
--- ]
--- ,[FirstWeapon]
,[CorridorDebug]
,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
--- ,[CorridorDebug]
--- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
,[Corridor]
,[OrAno
[[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
src/Dodge/Item/Weapon.hs
+2 -4
View File
@@ -430,12 +430,10 @@ miniGun = defaultAutoGun
miniGunPictItem :: Item -> SPic
miniGunPictItem it = miniGunPict spin (loadedAmmo it)
where
spin = 10 * _wpLoadedAmmo it + _wpCurWarmUp it
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 (rotateSHx a barrels)
<> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4)
<> colorSH red (prismPoly
@@ -452,7 +450,7 @@ miniGunPict spin am =
(map (addZ 0) $ rectNESW 4 12 (-4) (-5))
barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi]
a = fromIntegral spin / 100
x = fromIntegral am / 20
x = fromIntegral am / 10
clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4)
. upperPrismPoly 2
$ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))
src/Dodge/LevelGen/Block.hs
+2
View File
@@ -122,6 +122,8 @@ addBlock (p:ps) hp col isSeeThrough degradability w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlDraw = True
, _wlRotateTo = True
}
) is lns
wallInZone wl
src/Dodge/LevelGen/TriggerDoor.hs
+3 -2
View File
@@ -8,6 +8,7 @@ module Dodge.LevelGen.TriggerDoor
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.Default.Wall
import Dodge.LevelGen.Switch
import Dodge.LevelGen.Pathing
import Dodge.LevelGen.MoveDoor
@@ -66,7 +67,7 @@ putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor)
wlids = take 4 [IM.newKey $ _walls w ..]
wlps' = uncurry (rectanglePairs 9) $ head pss
addWalls w' = foldl' addWall w' $ zip wlids wlps'
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid Wall
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
{ _wlLine = wlps
, _wlID = wlid
, _wlColor = col
@@ -142,7 +143,7 @@ putSingleDoor isPathable col cond a b speed w = (drid, addWalls w
, _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
}
addWalls w' = foldl' addWall w' $ zip wlids pairs
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid Wall
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
{ _wlLine = wlps
, _wlID = wlid
, _wlColor = col
src/Dodge/LightSources/Fitting.hs
+16 -10
View File
@@ -7,23 +7,23 @@ import Geometry
mountedLight :: Point2 -> Point3 -> Placement
mountedLight wallPos lampPos@(V3 x y z)
= Placement (PS (V2 0 0) 0 $ PutForeground $ thinHighBar (z+5) wallPos pout)
$ \_ -> Just $ sPS (V2 0 0) 0 $ PutLS (colorLightAt 0.75 lampPos 0)
= ps0j (PutForeground $ thinHighBar (z+5) wallPos pout)
$ sps0 $ PutLS (colorLightAt 0.75 lampPos 0)
where
pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wallPos)
wallMountL :: Point2 -> Point3 -> Placement
wallMountL wallpos lamppos@(V3 x y z)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
mountLightL :: Point2 -> Point3 -> Placement
mountLightL wallpos lamppos@(V3 x y z)
= ps0j (PutLS $ colorLightAt 0.75 lamppos 0)
$ sps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
where
n = vNormal (wallpos -.- V2 x y)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
wallMountJ :: Point2 -> Point3 -> Placement
wallMountJ wallpos lamppos@(V3 x y z)
mountedLightJ :: Point2 -> Point3 -> Placement
mountedLightJ wallpos lamppos@(V3 x y z)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp turn1
<> thinHighBar (z + 5) turn1 turn2
@@ -46,13 +46,19 @@ wallMountl wallpos lamppos@(V3 x y z)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
wallMountA :: Point2 -> Point3 -> Placement
wallMountA wallpos lamppos@(V3 x y z)
mountLightA :: Point2 -> Point3 -> Placement
mountLightA wallpos lamppos@(V3 x y z)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ girder (z+10) 20 10 pout wallpos
where
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
mountColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
mountColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y h) 0)
$ sps0 $ PutForeground $ highPipe (h + 5) a b
where
V2 x y = 0.5 *.* (a +.+ b)
mountedLightI :: Float -> Point2 -> Point2 -> Placement
mountedLightI h a b = ps0j (PutLS $ lightAt (V3 x y h) 0)
$ sps0 $ PutForeground $ highPipe (h + 5) a b
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -259,7 +259,7 @@ wallsAndWindows w
= (map f wls, map f $ filter (fromMaybe True . (^? blVisible)) wins)
where
f wl = (_wlLine wl, _wlColor wl)
(wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w
(wins,wls) = partition _wlIsSeeThrough . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w
--(wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsOnScreen w
wallsToList :: [((Point2,Point2),Point4)] -> [Float]
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]
src/Dodge/Update.hs
+4 -2
View File
@@ -25,6 +25,7 @@ import Dodge.Floor
import Geometry
import Geometry.Vector3D
import SDL (MouseButton (..))
import Data.List
import Data.Maybe
import Data.Function
@@ -251,7 +252,8 @@ crCrSpring c1 c2 w
ifConfigWallRotate :: World -> World
ifConfigWallRotate w
| _rotate_to_wall $ _config w = rotateToOverlappingWall w
| (_rotate_to_wall $ _config w ) && not (ButtonRight `S.member` _mouseButtons w)
= rotateToOverlappingWall w
| otherwise = w
rotateToOverlappingWall :: World -> World
@@ -269,7 +271,7 @@ rotateToOverlappingWall w = case theWall of
b' = fromIntegral (round b :: Int)
cr = you w
p = _crPos cr
theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (wallsNearPoint p w)
theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (IM.filter _wlRotateTo $ wallsNearPoint p w)
{-
Finds the IDs of visible walls from a point to another point. -}