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

Start adding machines for storing/distributing items

Browse Source
This commit is contained in:
justin
2025-12-08 22:37:43 +00:00
parent 9e98cdc34b
commit 8b028c7f94
12 changed files with 251 additions and 181 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/AmmoType.hs
+4
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.AmmoType where
import Data.Aeson
import Data.Aeson.TH
data AmmoType
= LauncherAmmo
@@ -12,3 +15,4 @@ data AmmoType
| PrintMaterial
| ExplosivePutty
deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriveJSON defaultOptions ''AmmoType
src/Dodge/Data/Block.hs
+1 -1
View File
@@ -22,7 +22,7 @@ data Block = Block
, _blWallIDs :: IS.IntSet
, _blHP :: Int
, _blShadows :: [Int] -- a list of walls that are not shown when this block exists
, _blFootprint :: [Point2] -- TODO check whether this should be clockwise/anticlockwise
, _blFootprint :: [Point2] --clockwise!
, _blPos :: Point2
, _blDir :: Float
, _blHeight :: Float
src/Dodge/Data/Machine.hs
+15 -2
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Machine (
@@ -11,6 +12,8 @@ module Dodge.Data.Machine (
module Dodge.Data.GenParams,
) where
import ShortShow
import Dodge.Data.AmmoType
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -43,10 +46,20 @@ data MachineType
| McDamSensor DamageSensor
| McProxSensor ProximitySensor
| McTurret {_mctTurret :: Turret}
-- | McStorage
-- | McDistributer
| McStorage {_mcsType :: AmmoType, _mcsAmount :: Int}
| McDistributer {_mcdStorageMachine :: Maybe Int}
-- | McSynthesiser
instance ShortShow MachineType where
shortShow = \case
McStatic -> "McStatic"
McTerminal -> "McTerm"
McDamSensor {} -> "McDamSen"
McProxSensor {} -> "McProxSen"
McTurret {} -> "McTur"
McStorage {} -> "McStor"
McDistributer {} -> "McDist"
data Turret = Turret
{ _tuWeapon :: Int
, _tuTurnSpeed :: Float
src/Dodge/Machine/Draw.hs
+11
View File
@@ -1,5 +1,6 @@
module Dodge.Machine.Draw (drawMachine) where
import Dodge.Room.Foreground
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -20,10 +21,18 @@ drawMachine cw mc = case _mcType mc of
McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se
McProxSensor {} -> drawBaseMachine 25 mc
McStorage {} -> noPic $ colorSH (mcColor mc) storageShape
McDistributer {} -> drawBaseMachine 25 mc
where
lw = cw ^. lWorld
gp = cw ^. cwGen . cwgParams . sensorCoding
storageShape :: Shape
storageShape = upperBox Large Typical 31 (polyCirc 4 20) <>
foldMap toprail (take 8 [0, pi / 4 ..])
where
toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi / 4) $ V2 0 20)
drawDamSensor ::
M.Map SensorType (PaletteColor, DecorationShape) ->
DamageSensor ->
@@ -76,6 +85,8 @@ mcColor mc = case mc ^. mcType of
McDamSensor {} -> yellow
McProxSensor {} -> aquamarine
McTurret {} -> blue
McStorage {} -> orange
McDistributer {} -> red
drawTurret :: LWorld -> Turret -> Machine -> SPic
src/Dodge/Machine/Update.hs
+2
View File
@@ -36,6 +36,8 @@ mcTypeUpdate mc = \case
McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc
McProxSensor se -> mcProxSensorTriggerUpdate se mc . mcProxSensorUpdate se mc
McStorage {} -> id
McDistributer {} -> id
terminalScreenGlow :: Machine -> World -> World
terminalScreenGlow mc w = fromMaybe w $ do
src/Dodge/Placement/TopDecoration.hs
+17 -23
View File
@@ -28,32 +28,32 @@ midBarDecoration w h z =
where
w' = 0.3 * w
embossingR =
prismPoly
Medium
Typical
[V3 w h z, V3 w (0.3 * h) 41, V3 w (-0.3 * h) 41, V3 w (- h) z]
[V3 w' h z, V3 w' (0.3 * h) 41, V3 w' (-0.3 * h) 41, V3 w' (- h) z]
prismPoly
Medium
Typical
[V3 w h z, V3 w (0.3 * h) 41, V3 w (-0.3 * h) 41, V3 w (- h) z]
[V3 w' h z, V3 w' (0.3 * h) 41, V3 w' (-0.3 * h) 41, V3 w' (- h) z]
fourEmbossDecoration :: Float -> Float -> Float -> Shape
fourEmbossDecoration w h z = foldMap f [(w, h), (- w, h), (w, - h), (- w, - h)]
where
f (a, b) = translateSH (V3 (a / 2) (b / 2) z) embossing
embossing = upperBoxHalf Large Typical 10 $ rectNSWE (h / 2) (- h / 2) (- w / 2) (w / 2)
embossing = upperBoxHalf Large Typical 10 $ rectWH (w/2) (h/2)
plusDecoration :: Float -> Float -> Float -> Shape
plusDecoration w h z =
thinHighBar z (V2 w 0) (V2 (- w) 0)
<> thinHighBar z (V2 0 h) (V2 0 (- h))
thinHighBar z (V2 w 0) (V2 (- w) 0)
<> thinHighBar z (V2 0 h) (V2 0 (- h))
squareDecoration :: Float -> Float -> Float -> Shape
squareDecoration w h z =
foldMap
f
[ (w', - w', h', h')
, (w', - w', - h', - h')
, (w', w', h', - h')
, (- w', - w', h', - h')
]
foldMap
f
[ (w', - w', h', h')
, (w', - w', - h', - h')
, (w', w', h', - h')
, (- w', - w', h', - h')
]
where
w' = w - 1.5
h' = h - 1.5
@@ -65,14 +65,8 @@ circleDecoration w _ z = foldMap toprail (take 8 [0, pi / 4 ..])
toprail a = rotateSH a $ thinHighBar z (V2 0 w) (rotateV (pi / 4) $ V2 0 w)
threeLineDecoration :: Float -> Float -> Float -> Shape
threeLineDecoration w h z =
foldMap
f
[ (w', - w', h', h')
, (w', - w', 0, 0)
, (w', - w', - h', - h')
]
threeLineDecoration w h z = foldMap f [h', 0, - h']
where
w' = w - 1.5
h' = h - 1.5
f (a, c, b, d) = thinHighBar z (V2 a b) (V2 c d)
f x = thinHighBar z (V2 w' x) (V2 (- w') x)
src/Dodge/Room/Room.hs
+24
View File
@@ -10,8 +10,12 @@ module Dodge.Room.Room (
corDoor,
weaponBehindPillar,
critsRoom,
distributerRoom,
) where
import Shape
import Dodge.Default
import Dodge.Data.AmmoType
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Creature
@@ -404,5 +408,25 @@ critsRoom i =
, return <$> glassSwitchBackCrits i
]
distributerRoom :: AmmoType -> Int -> State LayoutVars Room
distributerRoom atype aamount = do
i <- nextLayoutInt
w <- state $ randomR (100, 400)
h <- state $ randomR (200, 400)
r <- roomRectAutoLinks w h
let mcstore = defaultMachine
& mcMaterial .~ Metal
& mcType .~ McStorage atype aamount
mcdist mj = defaultMachine
& mcMaterial .~ Metal
& mcType .~ McDistributer mj
store = sps (unusedOffPathAwayFromLink 50)
(PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just
in sps (unusedOffPathAwayFromLink 50)
(PutMachine (reverse $ square 10) (mcdist mj) Nothing)
return $ r & rmPmnts .:~ store
& rmInPmnt .:~ (0,dst)
-- cor <- shuffleLinks corridor
-- return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]
src/Dodge/Room/Tanks.hs
+3 -3
View File
@@ -12,8 +12,8 @@ import Dodge.PlacementSpot
import Dodge.Room.Foreground
import Dodge.Room.Modify.Girder
import Dodge.Room.Procedural
import Geometry
import LensHelp
import Linear
import RandomHelp
import Shape
@@ -38,7 +38,7 @@ randEdgeTank = do
return $
basetank
& plType . putBlock . blDraw
<>~ colorSH orange (verticalPipe 80 <> horPipe 80 0 (70 *.* cardVec edge))
<>~ colorSH orange (verticalPipe 80 <> horPipe 80 0 (70 *^ cardVec edge))
-- %~ fmap (<> noPic ( colorSH orange (verticalPipe 80
-- <> horPipe 80 0 (70 *.* cardVec edge))))
-- 70 is a guess, the true value depends on the distance to the wall
@@ -57,7 +57,7 @@ randEdgeTanks i = do
replicate i $
basetank
& plType . putBlock . blDraw
<>~ colorSH orange (verticalPipe 80 <> horPipe 80 0 (70 *.* cardVec edge))
<>~ colorSH orange (verticalPipe 80 <> horPipe 80 0 (70 *^ cardVec edge))
-- 70 is a guess, the true value depends on the distance to the wall
& plSpot
.~ rprBool
src/Dodge/Room/Tutorial.hs
+10 -1
View File
@@ -1,6 +1,7 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Room.Tutorial where
import Dodge.Data.AmmoType
import Dodge.Room.Path
import Dodge.Room.Pillar
import Dodge.Room.Boss
@@ -49,12 +50,20 @@ tutAnoTree = do
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, tToBTree "sdr" . return . cleatOnward <$>
(shuffleLinks =<< distributerRoom BulletAmmo 10000000)
, return $ tToBTree "cor" $ return $ cleatOnward corridor
--, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
, tToBTree "sdr" . return . cleatOnward <$> tanksPipesRoom
-- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
, return $ tToBTree "door" $ return $ cleatOnward door
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, tToBTree "sdr" . return . cleatOnward <$>
(shuffleLinks =<< tanksPipesRoom)
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "door" $ return $ cleatOnward door
, tutHub
, tutLight
, tutDrop
src/Dodge/TestString.hs
+6 -1
View File
@@ -32,7 +32,12 @@ import Data.Foldable
import Data.Monoid
testStringInit :: Universe -> [String]
testStringInit u = [show $ u^. uvWorld . wCam . camZoom]
testStringInit u = map show
(u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer)
<>
map f (u ^.. uvWorld . cWorld . lWorld . machines . traverse)
where
f mc = show (mc ^. mcID) <> shortShow (mc ^. mcType)
-- [show $ foldMap (foldMap (Sum . length . (^. seObstacles)))
-- $ u ^. uvWorld . cWorld . incGraph]
-- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor