diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 42396a3c6..7df7894af 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f88c63539..d4e566a1b 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 94163ae27..2eb42f1a9 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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] diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 9e0bb2528..bfeb21f5f 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -58,7 +58,6 @@ initialWorld = defaultWorld , _decorations = IM.empty , _storedLevel = Nothing , _menuLayers = [TerminalScreen 300 rezText'] - , _worldState = M.empty } testStringInit :: World -> [String] testStringInit _ = [] diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index ddfbc4d96..3b4c238dd 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -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 diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 2e65ba8dc..d6c4e2396 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -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 diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 477a8897d..3b57d5b4e 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -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) diff --git a/src/Dodge/Room/Furniture.hs b/src/Dodge/Room/Furniture.hs index 92699d618..ed02459a6 100644 --- a/src/Dodge/Room/Furniture.hs +++ b/src/Dodge/Room/Furniture.hs @@ -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 diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 128c59cdc..5cd20696f 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -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) ] ) diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 903ca660d..75046975e 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -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) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index be8f76b62..d6b3d0add 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Dodge/World/Trigger/Data.hs b/src/Dodge/World/Trigger/Data.hs index 48ecc7358..79ff1413e 100644 --- a/src/Dodge/World/Trigger/Data.hs +++ b/src/Dodge/World/Trigger/Data.hs @@ -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) diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index deeb2566d..5e5e3bd42 100644 --- a/src/Geometry/Vector3D.hs +++ b/src/Geometry/Vector3D.hs @@ -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 diff --git a/src/Quaternion.hs b/src/Quaternion.hs new file mode 100644 index 000000000..4b13bfef2 --- /dev/null +++ b/src/Quaternion.hs @@ -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) diff --git a/src/Shape.hs b/src/Shape.hs index 2dec774bc..348651c57 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -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)