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

Commit on return after gap

Browse Source
This commit is contained in:
justin
2025-03-27 18:22:57 +00:00
parent 4932952ed4
commit 836a3d9dd3
7 changed files with 80 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Data/LWorld.hs
+31 -11
View File
@@ -30,7 +30,7 @@ module Dodge.Data.LWorld (
module Dodge.Data.Machine,
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
-- module Dodge.Data.PathGraph,
-- module Dodge.Data.PathGraph,
module Dodge.Data.PosEvent,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
@@ -46,10 +46,12 @@ module Dodge.Data.LWorld (
module Dodge.Data.WorldEffect,
) where
import NewInt
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
--import Dodge.Data.PathGraph
import qualified Data.Map.Strict as M
import Dodge.Data.Beam
import Dodge.Data.Block
import Dodge.Data.Bounds
@@ -75,7 +77,6 @@ import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
--import Dodge.Data.PathGraph
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
@@ -91,8 +92,8 @@ import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Geometry.Data
import qualified IntMapHelp as IM
import NewInt
import Picture.Data
import qualified Data.Map.Strict as M
data LWorld = LWorld
{ _creatures :: IM.IntMap Creature
@@ -102,20 +103,21 @@ data LWorld = LWorld
, _gusts :: IM.IntMap Gust
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Projectile
-- , _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, -- , _instantBullets :: [Bullet]
_bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: Picture -- picture drawn for one frame
, _flares :: Picture -- picture drawn for one frame
, _teslaArcs :: [TeslaArc]
, _arcNode :: M.Map ArcNodeType Int
, _shockwaves :: [Shockwave]
, _lasers :: [Laser]
-- , _lasersToDraw :: [Laser]
, _linearShockwaves :: IM.IntMap LinearShockwave
, -- , _lasersToDraw :: [Laser]
_linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _walls :: IM.IntMap Wall
, _wallDamages :: IM.IntMap [Damage]
@@ -146,6 +148,7 @@ data LWorld = LWorld
, _hotkeys :: M.Map Hotkey (NewInt ItmInt)
, _imHotkeys :: NewIntMap ItmInt Hotkey
}
--data WorldBeams = WorldBeams
-- { _blockingBeams :: [Beam]
-- , _lightBeams :: [Beam]
@@ -153,11 +156,28 @@ data LWorld = LWorld
-- , _electronBeams :: [Beam]
-- }
data ArcNodeType
= WallArcNode
{ _wanPos :: Point2
, _wanID :: Int
}
| CrArcNode
{ _canID :: Int
}
deriving (Eq, Show, Read, Ord) --Generic, Flat)
makeLenses ''ArcNodeType
makeLenses ''LWorld
deriveJSON defaultOptions ''ArcNodeType
instance ToJSONKey ArcNodeType
instance FromJSONKey ArcNodeType
--makeLenses ''WorldBeams
concat
<$> mapM
(deriveJSON defaultOptions)
[-- ''WorldBeams
''LWorld
[ -- ''WorldBeams
''LWorld
]
src/Dodge/Default/World.hs
+1
View File
@@ -116,6 +116,7 @@ defaultLWorld =
, -- , _newBeams = WorldBeams [] [] [] []
-- , _beams = WorldBeams [] [] [] []
_teslaArcs = []
, _arcNode = mempty
, _shockwaves = []
, _lasers = []
-- , _lasersToDraw = []
src/Dodge/Inventory/Path.hs
+1 -1
View File
@@ -11,7 +11,7 @@ getInventoryPath x ip itid cr = case ip of
RELCURS -> do
selid <- cr ^? crManipulation . manObject . imSelectedItem
guard $ (x + selid) `IM.member` (cr ^. crInv)
return $ (x + selid)
return (x + selid)
RELITEM
| (itid + x) `IM.member` (cr ^. crInv) ->
return $ itid + x
src/Dodge/Inventory/SelectionList.hs
+2 -2
View File
@@ -46,7 +46,7 @@ invSelectionItem w indent loc =
-- space leak
itemDisplay :: World -> Creature -> ComposedItem -> [String]
itemDisplay w cr ci = -- f
(basicItemDisplay itm)
basicItemDisplay itm
-- (itemNumberDisplay w cr ci)
`g` anyextra
where
@@ -104,7 +104,7 @@ itemExternalValue itm w cr
| otherwise = mempty
ugateCalc :: Int -> Int -> Int
ugateCalc x y = (x `div` ((2::Int) ^ ((f y) ::Int))::Int) `mod` 2
ugateCalc x y = (x `div` ((2::Int) ^ (f y ::Int))::Int) `mod` 2
where
f i | i > 0 = 1
| otherwise = 0
src/Dodge/Tesla.hs
+43 -19
View File
@@ -1,11 +1,10 @@
module Dodge.Tesla (
makeTeslaArc,
-- updateTeslaArc,
-- updateTeslaArc,
) where
import Dodge.Movement.Turn
import Control.Applicative
import Control.Monad
import Dodge.WorldEvent.ThingsHit
--import Control.Applicative
--import Data.Foldable
--import Data.List (uncons) --(sortOn)
@@ -15,6 +14,8 @@ import Data.Maybe
import Dodge.Data.ArcStep
import Dodge.Data.CrWlID
import Dodge.Data.World
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
--import Dodge.Spark
import Geometry
--import qualified IntMapHelp as IM
@@ -22,6 +23,7 @@ import LensHelp
--import MonadHelp
import Picture
import RandomHelp
--import Shape
makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
@@ -40,36 +42,58 @@ makeTeslaArc ip pos dir w =
newarc = updateArc ip w pos dir & evalState $ _randGen w
updateArc :: ItemParams -> World -> Point2 -> Float -> State StdGen [ArcStep]
updateArc ip w p dir = take 10 <$> zipArcs dir w (ArcStep p dir NothingID) carc
updateArc ip w p dir = take 10 <$> zipArcs endarc w (ArcStep p dir NothingID) carc
where
endarc = snd <$> unsnoc (_currentArc ip)
carc = case _currentArc ip of
(_ : xs) -> xs
[] -> []
zipArcs :: Float -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
zipArcs d w x ys = (x:) <$> do
let mys = uncons ys
na <- nextArc d w x (fmap fst mys)
case na of
Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
Nothing -> return []
zipArcs :: Maybe ArcStep -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
zipArcs d w x ys =
(x :) <$> do
let mys = uncons ys
na <- nextArc d w x (fmap fst mys)
case na of
Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
Nothing -> return []
nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
nextArc _ w lastarc mx
nextArc ::
Maybe ArcStep ->
World ->
ArcStep ->
Maybe ArcStep ->
State StdGen (Maybe ArcStep)
nextArc endarc w lastarc mx
| ArcStep p d NothingID <- lastarc = do
offset <- randInCirc 5
offset <- randInCirc 20
let pdir = 20 * unitVectorAtAngle d
(dout,pout) = fromMaybe (d,pdir) $ do
p' <- mx ^? _Just . asPos
let d' = turnTo 0.5 p p' d
return $ (d', vecTurnTo 0.5 p p' pdir)
newp = p + pout + offset
(dout, pout) = fromMaybe (d, pdir) $ do
p' <- endArcPos endarc <|> mx ^? _Just . asPos
let tangle = 0.5
d' = turnTo tangle p p' d
return (d', vecTurnTo tangle p p' pdir)
newp = fromMaybe (p + pout + offset) $ do
p' <- endArcPos endarc
guard $ dist p' p < 20
return p'
return $ case thingHit p newp w of
Nothing -> Just $ ArcStep newp dout NothingID
Just (p', Left cr) -> Just $ ArcStep p' dout (CrID (_crID cr))
Just (p', Right wl) -> Just $ ArcStep p' dout (WlID (_wlID wl))
| otherwise = return Nothing
-- might want to check whether any cr/wall exists
endArcPos :: Maybe ArcStep -> Maybe Point2
endArcPos mas = do
as <- mas
case as ^. asObject of
NothingID -> Nothing
CrID {} -> do
as ^? asPos
WlID {} -> do
as ^? asPos
--nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
--nextArc d w lastarc mx
-- | ArcStep p d NothingID <- lastarc = do
src/Geometry/Vector.hs
+1 -5
View File
@@ -192,11 +192,7 @@ dist :: Point2 -> Point2 -> Float
dist !p1 !p2 = magV (p2 -.- p1)
-- | Finds a new angle a given fraction between two other angles
tweenAngles ::
Float ->
Float ->
Float ->
Float
tweenAngles :: Float -> Float -> Float -> Float
{-# INLINE tweenAngles #-}
tweenAngles frac a1 a2
| abs (a1 - a2) < pi = frac * (a1 - a2) + a2