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

Cleanup

Browse Source
This commit is contained in:
justin
2021-10-19 13:14:52 +01:00
parent d46de1ca80
commit 9e9d2b5def
15 changed files with 71 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+4 -6
View File
@@ -20,7 +20,6 @@ import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
import Dodge.Item.Data
import Dodge.World.Trigger.Data
import Dodge.Bounds
import Data.Preload
import Picture.Data
@@ -82,7 +81,7 @@ data World = World
, _storedLevel :: Maybe World
, _quicksaveLevel :: Maybe World
, _menuLayers :: [ScreenLayer]
, _worldState :: M.Map WorldState Bool
-- , _worldState :: M.Map WorldState Bool
, _worldTriggers :: S.Set WorldTrigger
, _carteDisplay :: !Bool
, _carteCenter :: !Point2
@@ -236,10 +235,9 @@ data CrMvType
, _mvTurnJit :: Float
, _mvAimSpeed :: Float -> Float
}
data WorldState
= DoorNumOpen Int
| DoorNumOpening Int
| CrNumAlive Int
data WorldTrigger
= ResetLevel Int
| GameOver
deriving (Eq,Ord)
data Button = Button
{ _btPict :: Button -> SPic
src/Dodge/Default/World.hs
+1 -1
View File
@@ -55,7 +55,7 @@ defaultWorld = World
, _storedLevel = Nothing
, _quicksaveLevel = Nothing
, _menuLayers = []
, _worldState = M.empty
-- , _worldState = M.empty
, _worldTriggers = S.empty
, _clickMousePos = V2 0 0
, _pathGraph = Data.Graph.Inductive.Graph.empty
src/Dodge/Floor.hs
+3 -16
View File
@@ -5,40 +5,24 @@ module Dodge.Floor
( levx
) where
import Geometry.Data
--import Picture
import Dodge.Data
--import Dodge.Room
import Dodge.Creature.State.Data
--import Dodge.Creature.SwarmCrit
import Dodge.Room.Procedural
import Dodge.Room.RoadBlock
import Dodge.Room.Data
import Dodge.Room
--import Dodge.Room.Link
--import Dodge.Room.Door
import Dodge.Room.Branch
import Dodge.Room.Boss
--import Dodge.Room.Airlock
import Dodge.Room.LongDoor
import Dodge.Room.NoNeedWeapon
--import Dodge.Base
--import Dodge.Layout
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
--import Dodge.Layout.Tree.GenerateStructure
import Dodge.Layout.Tree.Annotate
import Dodge.Layout.Tree.Shift
import Dodge.Creature
--import Dodge.SoundLogic
--import Dodge.RandomHelp
--import Dodge.LightSources
import Dodge.LevelGen.Data
--import Dodge.LevelGen.SwarmPlacement
--import Dodge.Item.Weapon
import Dodge.Item.Weapon.Launcher
--import Data.Tree
--import Data.Maybe (fromJust,isNothing)
import Control.Lens
import Control.Monad.State
import Control.Monad.Loops
@@ -52,6 +36,9 @@ initialRoomTree = do
[[StartRoom]
,[Corridor]
,[Corridor]
,[AirlockAno]
,[Corridor]
,[Corridor]
---- ,[SpecificRoom roomCCrits]
---- ,[Corridor]
---- ,[Corridor]
src/Dodge/Initialisation.hs
-1
View File
@@ -58,7 +58,6 @@ initialWorld = defaultWorld
, _decorations = IM.empty
, _storedLevel = Nothing
, _menuLayers = [TerminalScreen 300 rezText']
, _worldState = M.empty
}
testStringInit :: World -> [String]
testStringInit _ = []
src/Dodge/Layout/Tree/Annotate.hs
+5 -13
View File
@@ -46,28 +46,20 @@ addLock i t = do
(beforeLock, afterLock) <- splitTrunk t
newBefore <- applyToRandomNode (Key i :) beforeLock
return $ addToTrunk newBefore [Node [Lock i] afterLock]
{- |
Add one corridor between each parent-child link of a tree of annotations.
-}
{- | Add one corridor between each parent-child link of a tree of annotations. -}
padCorridors :: Tree [Annotation g] -> Tree [Annotation g]
padCorridors (Node x xs) = Node [Corridor] [Node x (map padCorridors xs)]
{-
Add one to three corridors between each parent-child link of a tree of annotations.
-}
{- Add one to three corridors between each parent-child link of a tree of annotations. -}
randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
randomPadCorridors (Node x xs) = do
n <- state $ randomR (1, 3)
xs' <- mapM randomPadCorridors xs
return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
{- |
Add a corridor to a random out-link of a room.
-}
{- | Add a corridor to a random out-link of a room. -}
roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r])
(randomiseOutLinks corridor)
{- |
Create a random room tree structure from a list of annotations.
-}
{- | Create a random room tree structure from a list of annotations. -}
annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
annoToRoomTree [OrAno as] = do
a <- takeOne as
@@ -75,7 +67,7 @@ annoToRoomTree [OrAno as] = do
annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor
annoToRoomTree [CorridorDebug] = pure . Right <$> randomiseOutLinks corridorDebug
annoToRoomTree [DoorAno] = roomThenCorridor door
annoToRoomTree [DoorNumAno _,AirlockAno] = airlock >>= roomThenCorridor
annoToRoomTree [AirlockAno] = airlock >>= roomThenCorridor
annoToRoomTree [FirstWeapon] = do
branchWP <- branchRectWith weaponRoom
blockedC <- longBlockedCorridor
src/Dodge/Room/Airlock.hs
+8 -42
View File
@@ -1,8 +1,6 @@
{-# LANGUAGE TupleSections #-}
{-
Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock
where
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Room.Data
import Dodge.LightSources.Fitting
import Dodge.Room.Placement
@@ -15,49 +13,18 @@ import Dodge.RandomHelp
import Geometry
import Picture
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
import Control.Lens
airlockOneWay :: Int -> Room
airlockOneWay n = defaultRoom
{ _rmPolys = [rectNSWE 90 0 0 40]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40) 2
,sPS (V2 0 75) 0 $ PutDoubleDoor col cond (V2 0 0) (V2 0 40) 2
,sPS (V2 35 45) (pi/2) $ PutButton $ makeButton col (over worldState
(M.insert (DoorNumOpen n) True))
]
--, _rmBound = rectNSWE 90 30 (-30) 30
, _rmBound = [rectNSWE 75 15 0 40]
}
where lnks = [(V2 0 85,0)
,(V2 0 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
{- |
A passage with a switch that opens forward access while closing backwards access. -}
{- | A passage with a switch that opens forward access while closing backwards access. -}
airlock :: RandomGen g => State g Room
--airlock = takeOne [airlock0,airlock90,airlockCrystal]
airlock = takeOne [airlock0]
{- |
Straight airlock -}
airlock = takeOne [airlock0,airlock90,airlockCrystal]
{- | Straight airlock -}
airlock0 :: Room
airlock0 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
]
{ _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
, _rmLinks = lnks
, _rmPath = [(V2 20 95,V2 20 45)
,(V2 20 45,V2 20 5)
]
, _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
, _rmPS =
[Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 20) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 0) (V2 39 0) 2)
@@ -74,8 +41,7 @@ airlock0 = defaultRoom
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
airlock90
:: Room
airlock90 :: Room
airlock90 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
src/Dodge/Room/Foreground.hs
+6 -3
View File
@@ -8,6 +8,7 @@ import Geometry
--import Geometry.Data
import Geometry.Vector3D
import Shape
import Quaternion
import Data.List
import Data.Maybe
@@ -133,9 +134,11 @@ 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)
(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)
src/Dodge/Room/Furniture.hs
+5 -5
View File
@@ -8,9 +8,10 @@ import Dodge.Default.Wall
import Geometry
import Shape
import Color
--import Quaternion
roundTankTopRail :: Color -> Float -> Float -> Placement
roundTankTopRail col x y = shiftPlacement (V2 x y,0) $ ps0j
roundTank :: Color -> Float -> Float -> Placement
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
@@ -47,8 +48,8 @@ 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
(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}
@@ -77,7 +78,6 @@ tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
[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
src/Dodge/Room/Start.hs
+6 -5
View File
@@ -11,6 +11,7 @@ import Dodge.LevelGen.Data
import Dodge.LightSources.Fitting
import Geometry.Data
import Color
import Shape
import Data.Tree
import Control.Monad.State
@@ -26,15 +27,15 @@ startRoom = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let fground = sPS (V2 0 0) 0 $ PutForeground $
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 40 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h )
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPS .~
$ roomRectAutoLinks w h & rmPS .~
[ fground
, mountedLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquareEmboss4 (dim orange) 50 50
, tankSquare (dim orange) 50 50
, tankSquare (dim orange) 50 120
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
]
)
src/Dodge/Room/Teleport.hs
+3 -7
View File
@@ -1,15 +1,11 @@
{-
Specification of rooms that teleport (between levels).
-}
{- Specification of rooms that teleport (between levels). -}
module Dodge.Room.Teleport
where
import Dodge.Data
import Dodge.World.Trigger.Data
import Dodge.Base
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Placement
--import Dodge.Layout
import Dodge.LevelGen.Data
import Geometry
import Picture
@@ -42,6 +38,6 @@ telRoomLev i = do
}
ppFootprint = rectNSEW 20 (-20) 20 (-20)
levelReset pp w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $ startNewGame w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $
w & worldTriggers %~ S.insert (ResetLevel i)
| otherwise = w
startNewGame w = w & worldTriggers %~ S.insert (ResetLevel i)
src/Dodge/Update.hs
+1 -4
View File
@@ -9,14 +9,11 @@ import Dodge.Data
import Dodge.Menu
import Dodge.Zone.Data
import Dodge.Config.Data
import Dodge.World.Trigger.Data
--import Dodge.Config.Data
import Dodge.Base
import Dodge.Zone
import Dodge.WallCreatureCollisions
import Dodge.LevelGen.Block
import Dodge.Update.Camera
--import Dodge.Update.UsingInput
import Dodge.SoundLogic
import Dodge.Inventory
import Dodge.Initialisation
@@ -252,7 +249,7 @@ crCrSpring c1 c2 w
ifConfigWallRotate :: World -> World
ifConfigWallRotate w
| (_rotate_to_wall $ _config w ) && not (ButtonRight `S.member` _mouseButtons w)
| _rotate_to_wall (_config w) && not (ButtonRight `S.member` _mouseButtons w)
= rotateToOverlappingWall w
| otherwise = w
src/Dodge/World/Trigger/Data.hs
+3 -10
View File
@@ -1,12 +1,5 @@
{- |
World triggers are intended to help me handle global events,
{- | World triggers are intended to help me handle global events,
such as new levels, game overs, etc, that disrupt the typical flow of the game.
They should probably be used sparingly.
-}
module Dodge.World.Trigger.Data
where
They should probably be used sparingly. -}
module Dodge.World.Trigger.Data where
data WorldTrigger
= ResetLevel Int
| GameOver
deriving (Eq,Ord)
src/Geometry/Vector3D.hs
+8 -9
View File
@@ -38,6 +38,7 @@ a *.*.* (V3 x2 y2 z2) =
in V3 x y z
crossProd :: Point3 -> Point3 -> Point3
{-# INLINE crossProd #-}
crossProd (V3 x y z) (V3 a b c) = V3
( y * c - z * b)
( z * a - x * c)
@@ -109,18 +110,16 @@ orderAround3 v ps = sortOn (argV . prj) ps
vCen3 :: [Point3] -> Point3
vCen3 ps = (1 / fromIntegral (length ps)) *.*.* foldr (+.+.+) (V3 0 0 0) ps
dotV3
:: Point3
-> Point3
-> Float
dotV3 :: Point3 -> Point3 -> Float
dotV3 (V3 x y z) (V3 a b c) = x*a + y*b + z*c
projV3
:: Point3
-> Point3
-> Point3
projV3 = undefined
angleVV3 :: Point3 -> Point3 -> Float
angleVV3 a b
| a == b = 0
| otherwise = acos $ dotV3 a b / (magV3 a * magV3 b)
projV3 :: Point3 -> Point3 -> Point3
projV3 = undefined
onXY :: (Point2 -> Point2) -> Point3 -> Point3
onXY f (V3 x y z) = V3 x' y' z
src/Quaternion.hs
+13
View File
@@ -0,0 +1,13 @@
module Quaternion
where
import Geometry.Data
import Geometry.Vector3D
import qualified Linear.Quaternion as Q
-- apply a rotation as if the z axis moves to the new point.
rotateToZ :: Point3 -> Point3 -> Point3
rotateToZ z1
| cprod == V3 0 0 0 = id
| otherwise = Q.rotate $ Q.axisAngle cprod (angleVV3 z1 (V3 0 0 1))
where
cprod = crossProd z1 (V3 0 0 1)
src/Shape.hs
+5
View File
@@ -14,6 +14,7 @@ module Shape
, polyCircx
, scaleSH
, colorSH
, overPosSH
)
where
import Geometry
@@ -111,6 +112,10 @@ rotateSH :: Float -> Shape -> Shape
{-# INLINE rotateSH #-}
rotateSH a = overPos (rotate3 a)
overPosSH :: (Point3 -> Point3) -> Shape -> Shape
{-# INLINEABLE overPosSH #-}
overPosSH = overPos
rotateSHx :: Float -> Shape -> Shape
{-# INLINE rotateSHx #-}
rotateSHx a = overPos (rotate3x a)