Add sounds, move data types out into separate folders

src/Dodge/Block.hs

@@ -1,7 +1,7 @@
 module Dodge.Block where
 import Dodge.Data
 import Dodge.Base.Collide
-import Dodge.Material
+import Dodge.Material.Sound
 import Dodge.Block.Debris
 import Dodge.Zone
 import Dodge.LightSource

src/Dodge/Block/Debris.hs

@@ -1,5 +1,5 @@
 module Dodge.Block.Debris where
-import Dodge.Material
+import Dodge.Material.Sound
 import Dodge.Prop.Moving
 import Dodge.WorldEvent.Sound
 --import Dodge.Zone
@@ -106,6 +106,8 @@ debrisSize mt = case mt of
     Dirt    -> 20
     Wood    -> 10
     Metal   -> 10
+    Electronics -> 10
+    Flesh -> 10
 
 baseDebris :: Material -> State StdGen Prop
 baseDebris mt = case mt of
@@ -118,6 +120,8 @@ baseDebris mt = case mt of
         sh <- jaggedShape
         return $ metalDebris
             & prDraw .~ (`drawMovingShapeCol` sh)
+    Electronics -> baseDebris Metal
+    Flesh   -> baseDebris Dirt <&> pjColor .~ red
 
 stoneDebris :: Prop
 stoneDebris = PropZ

src/Dodge/Creature/Damage.hs

@@ -14,6 +14,12 @@ import Data.List
 applyNoDamage :: [Damage] -> Creature -> World -> World
 applyNoDamage _ _ = id
 
+applyCreatureDamage :: [Damage] -> Creature -> World -> World
+applyCreatureDamage dms cr = case _crMaterial cr of
+    Flesh -> defaultApplyDamage dms cr
+    Crystal -> id
+    _-> defaultApplyDamage dms cr
+
 defaultApplyDamage :: [Damage] -> Creature -> World -> World
 defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
     & creatures . ix (_crID cr) %~ doPoisonDam

src/Dodge/Creature/Inanimate.hs

@@ -54,8 +54,8 @@ explosiveBarrel = defaultInanimate
         {_csSpState = Barrel []
         }
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
-    ,_crApplyDamage = \_ _ -> id
     }
+    & crMaterial .~ Crystal
 updateBarrel :: Creature -> World -> World
 updateBarrel cr
     | _crHP cr > 0 = doDamage cr

src/Dodge/Creature/Lamp.hs

@@ -3,7 +3,7 @@ module Dodge.Creature.Lamp
     , colorLamp
     ) where
 import Dodge.Data
-import Dodge.Material
+import Dodge.Material.Sound
 import Dodge.Default
 import Dodge.Creature.Picture
 import Dodge.LightSource

src/Dodge/Creature/State.hs

@@ -10,6 +10,7 @@ import Dodge.Prop.Gib
 import Dodge.Base
 import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.Impulse.Movement
+import Dodge.Creature.Damage
 import Dodge.LightSource.Torch
 import Dodge.SoundLogic
 import RandomHelp
@@ -134,7 +135,7 @@ clearDamage cr w = w
 doDamage :: Creature -> World -> World
 doDamage cr w = w
     & applyPastDamages cr
-    & _crApplyDamage cr dams cr
+    & applyCreatureDamage dams cr
   where 
     dams = _csDamage $ _crState cr
 

src/Dodge/Creature/YourControl.hs

@@ -19,7 +19,7 @@ import qualified Data.Map.Strict as M
 {- | The AI equivalent for your control. -}
 yourControl :: Creature -> World -> World
 yourControl cr w 
-    | inTermFocus w = w
+    | inTermFocus w = w & updateUsingInput
     | otherwise = w
         & creatures . ix (_crID cr) %~ 
             (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))

src/Dodge/Data.hs

@@ -10,7 +10,11 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.RightButtonOptions
     , module Dodge.Data.Material
+    , module Dodge.Data.LightSource
+    , module Dodge.Data.Creature
+    , module Dodge.Data.Block
     , module Dodge.Data.Flare
     , module Dodge.Data.LoadAction
     , module Dodge.Data.ForegroundShape
@@ -18,6 +22,7 @@ module Dodge.Data
     , module Dodge.Data.Object
     , module Dodge.Data.Zoning
     , module Dodge.Data.Bounds
+    , module Dodge.Data.Sensor
     , module Dodge.Combine.Data
     , module Dodge.Distortion.Data
     , module Dodge.Data.DamageType
@@ -38,7 +43,12 @@ module Dodge.Data
     , module Dodge.Data.PathGraph
     ) where
 import Dodge.Data.RadarBlip
+import Dodge.Data.RightButtonOptions
+import Dodge.Data.LightSource
+import Dodge.Data.Creature
 import Dodge.Data.Room
+import Dodge.Data.Block
+import Dodge.Data.Sensor
 import Dodge.Data.Flare
 import Dodge.Data.PathGraph
 import Dodge.Data.Object
@@ -202,41 +212,6 @@ data HUDElement
     = DisplayInventory {_subInventory :: SubInventory}
     | DisplayCarte
 --  deriving (Eq,Ord,Show)
-data RightButtonOptions
-    = NoRightButtonOptions
-    | EquipOptions 
-        {_opEquip       :: [EquipPosition]
-        ,_opSel         :: Int
-        ,_opCurInvPos   :: Int
-        ,_opAllocateEquipment :: AllocateEquipment
-        ,_opActivateEquipment :: ActivateEquipment
-        }
-data ActivateEquipment
-    = ActivateEquipment {_activateEquipment :: Int }
-    | DeactivateEquipment {_deactivateEquipment :: Int}
-    | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int}
-    | NoChangeActivateEquipment
-data AllocateEquipment 
-    = DoNotMoveEquipment
-    | PutOnEquipment
-        { _allocNewPos :: EquipPosition
-        }
-    | MoveEquipment
-        { _allocNewPos  :: EquipPosition
-        , _allocOldPos  :: EquipPosition
-        }
-    | SwapEquipment
-        { _allocNewPos  :: EquipPosition
-        , _allocOldPos  :: EquipPosition
-        , _allocSwapID  :: Int
-        }
-    | ReplaceEquipment
-        { _allocNewPos  :: EquipPosition
-        , _allocRemoveID :: Int
-        }
-    | RemoveEquipment
-        { _allocOldPos  :: EquipPosition
-        }
 
 data SubInventory 
     = NoSubInventory
@@ -342,17 +317,6 @@ data Cloud = Cloud
 data CloudType
     = SmokeCloud
     | GasCloud
-data LSParam = LSParam
-    { _lsPos        :: !Point3
-    , _lsRad        :: !Float
-    , _lsCol        :: !Point3
-    }
-data LightSource = LS  
-    { _lsID     :: !Int
-    , _lsParam  :: LSParam
-    , _lsDir    :: !Float
-    , _lsPict   :: LightSource -> Picture
-    }
 data TempLightSource = TLS 
     { _tlsParam     :: LSParam
     , _tlsUpdate    :: World -> TempLightSource -> Maybe TempLightSource
@@ -389,7 +353,8 @@ data Creature = Creature
     , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
     , _crCorpse         :: Creature -> Corpse -> SPic
-    , _crApplyDamage    :: [Damage] -> Creature -> World -> World
+    , _crMaterial       :: Material
+--    , _crApplyDamage    :: [Damage] -> Creature -> World -> World
     , _crPastDamage     :: Int
     , _crStance         :: Stance
     , _crActionPlan     :: ActionPlan
@@ -406,37 +371,11 @@ data Creature = Creature
     , _crStatistics     :: CreatureStatistics
     , _crCamouflage     :: CamouflageStatus
     }
-data CamouflageStatus
-    = FullyVisible
-    | Invisible
-    deriving (Eq,Ord,Enum)
-data CreatureStatistics = CreatureStatistics
-    { _strength       :: Int
-    , _dexterity      :: Int
-    , _intelligence   :: Int
-    }
-data Vocalization 
-    = Mute
-    | Vocalization
-        {_vcSound :: SoundID
-        ,_vcWarnings :: [SoundID]
-        ,_vcMaxCoolDown :: Int
-        ,_vcCoolDown    :: Int
-        }
 data Intention = Intention
     { _targetCr     :: Maybe Creature
     , _mvToPoint    :: Maybe Point2
     , _viewPoint    :: Maybe Point2
     }
-data CrMvType 
-    = NoMvType
-    | MvWalking { _mvSpeed :: Float }
-    | CrMvType
-        { _mvSpeed      :: Float
-        , _mvTurnRad    :: Float -> Float
-        , _mvTurnJit    :: Float
-        , _mvAimSpeed   :: Float -> Float
-        }
 data Button = Button 
     { _btPict   :: Button -> SPic
     , _btPos    :: Point2
@@ -511,10 +450,6 @@ data Equipment = Equipment
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
 
-data HeldAttachment
-    = Torch
-    | NoHeldAttachment
-
 data ItemConsumption
     = LoadableAmmo
         { _laAmmoType   :: AmmoType
@@ -978,19 +913,6 @@ data Prop
         , _pjTimer :: Int
         }
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
-data Block = Block
-    { _blID         :: Int
-    , _blWallIDs    :: IS.IntSet
-    , _blHP         :: Int
-    , _blShadows    :: [Int]   -- a list of blocks/walls? that are not shown when this block exists
-    , _blFootprint  :: [Point2]
-    , _blPos        :: Point2
-    , _blDir        :: Float
-    , _blHeight     :: Float
-    , _blMaterial   :: Material
-    , _blDraw       :: Block -> SPic
-    , _blObstructs  :: [(Int,Int,PathEdge)]
-    }
 data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
   deriving (Eq,Ord,Show)
 data TerminalInput = TerminalInput
@@ -1000,7 +922,7 @@ data TerminalInput = TerminalInput
     }
 data Terminal = Terminal
     { _tmID         :: Int 
-    , _tmProgram    :: Terminal -> World -> [TerminalLine]
+    , _tmBootProgram    :: Terminal -> World -> [TerminalLine]
     , _tmButtonID   :: Int
     , _tmMachineID  :: Int
     , _tmName       :: String
@@ -1020,49 +942,22 @@ data TerminalToggle = TerminalToggle
     { _ttTriggerID :: Int
     , _ttDeathEffect :: (World -> Bool) -> (World -> Bool)
     }
---data DamageApplication
---    = ApplyNoDamage
---    | DefaultApplyDamage
-
 data Machine = Machine
     { _mcID     :: Int
     , _mcWallIDs    :: IS.IntSet
---    , _mcUpdate :: Machine -> World -> World
     , _mcDraw   :: Machine -> SPic
---    , _mcDamageApplication :: DamageApplication
+    , _mcMaterial :: Material
     , _mcPos    :: Point2
     , _mcDir    :: Float
     , _mcColor  :: Color
     , _mcHP     :: Int
     , _mcSensor :: Sensor
     , _mcDamage :: [Damage]
-    , _mcLSs    :: [Int]
     , _mcType   :: MachineType
     , _mcMounts :: M.Map Object Int
     , _mcName   :: String
---    , _mcTriggerCond :: Machine -> Bool
     , _mcCloseSound  :: Maybe SoundID
---    , _mcTermMID :: Maybe Int
     }
-data Sensor = NoSensor
-    | SensorToggleAmount
-        { _sensToggle :: Bool
-        , _sensAmount :: Int
-        }
-    | ProximitySensor
-        { _proxStatus   :: CloseToggle
-        , _proxDist :: Float
-        , _proxRequirement :: ProximityRequirement
-        , _sensToggle :: Bool
-        }
-  deriving (Eq,Ord)
-data ProximityRequirement
-    = RequireHealth {_proxReqMinHealth :: Int}
-    | RequireEquipment {_proxReqEquipment :: ItemBaseType}
-    | RequireImpossible
-  deriving (Eq,Ord,Show)
-data CloseToggle = NotClose | IsClose
-  deriving (Eq,Ord,Show)
 data MachineType 
     = StaticMachine
     | Turret
@@ -1547,7 +1442,6 @@ makeLenses ''DamageEffect
 makeLenses ''World
 makeLenses ''Cloud
 makeLenses ''Creature
-makeLenses ''LightSource
 makeLenses ''TempLightSource
 makeLenses ''Item
 makeLenses ''ItemUse
@@ -1566,17 +1460,13 @@ makeLenses ''ActionPlan
 makeLenses ''Impulse
 makeLenses ''Action
 makeLenses ''CrGroupParams
-makeLenses ''CrMvType 
 makeLenses ''Intention
 makeLenses ''Door
-makeLenses ''Block
 makeLenses ''Terminal
 makeLenses ''Machine
 makeLenses ''MachineType
 makeLenses ''ItemDimension
-makeLenses ''Vocalization
 makeLenses ''Universe
-makeLenses ''LSParam
 makeLenses ''ItemParams
 makeLenses ''ItemTweaks
 makeLenses ''ItemPortage
@@ -1592,16 +1482,10 @@ makeLenses ''TerminalLine
 makeLenses ''ItemValue
 makeLenses ''Equipment
 makeLenses ''ScreenLayer
-makeLenses ''Sensor
-makeLenses ''ProximityRequirement
 makeLenses ''Beam
 makeLenses ''BeamType
 makeLenses ''WorldBeams
 makeLenses ''ArcStep
-makeLenses ''CreatureStatistics
-makeLenses ''RightButtonOptions
-makeLenses ''AllocateEquipment
-makeLenses ''ActivateEquipment
 makeLenses ''EquipParams
 makeLenses ''TerminalCommand
 makeLenses ''TerminalInput

src/Dodge/Data/Block.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Block where
+import Dodge.Data.Material
+import Dodge.Data.PathGraph
+import ShapePicture
+import Geometry
+import Control.Lens
+import qualified Data.IntSet as IS
+data Block = Block
+    { _blID         :: Int
+    , _blWallIDs    :: IS.IntSet
+    , _blHP         :: Int
+    , _blShadows    :: [Int]   -- a list of blocks/walls? that are not shown when this block exists
+    , _blFootprint  :: [Point2]
+    , _blPos        :: Point2
+    , _blDir        :: Float
+    , _blHeight     :: Float
+    , _blMaterial   :: Material
+    , _blDraw       :: Block -> SPic
+    , _blObstructs  :: [(Int,Int,PathEdge)]
+    }
+makeLenses ''Block

src/Dodge/Data/Creature.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Creature where
+import Sound.Data
+import Control.Lens
+data CamouflageStatus
+    = FullyVisible
+    | Invisible
+  deriving (Eq,Ord,Enum)
+data CreatureStatistics = CreatureStatistics
+    { _strength       :: Int
+    , _dexterity      :: Int
+    , _intelligence   :: Int
+    }
+  deriving (Eq,Ord,Show)
+data Vocalization 
+    = Mute
+    | Vocalization
+        {_vcSound :: SoundID
+        ,_vcWarnings :: [SoundID]
+        ,_vcMaxCoolDown :: Int
+        ,_vcCoolDown    :: Int
+        }
+  deriving (Eq,Ord,Show)
+data CrMvType 
+    = NoMvType
+    | MvWalking { _mvSpeed :: Float }
+    | CrMvType
+        { _mvSpeed      :: Float
+        , _mvTurnRad    :: Float -> Float
+        , _mvTurnJit    :: Float
+        , _mvAimSpeed   :: Float -> Float
+        }
+makeLenses ''CreatureStatistics
+makeLenses ''Vocalization
+makeLenses ''CrMvType 

src/Dodge/Data/LightSource.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.LightSource where
+import Geometry
+import Picture.Data
+import Control.Lens
+
+data LSParam = LSParam
+    { _lsPos        :: !Point3
+    , _lsRad        :: !Float
+    , _lsCol        :: !Point3
+    }
+data LightSource = LS  
+    { _lsID     :: !Int
+    , _lsParam  :: LSParam
+    , _lsDir    :: !Float
+    , _lsPict   :: LightSource -> Picture
+    }
+makeLenses ''LSParam
+makeLenses ''LightSource

src/Dodge/Data/Material.hs

@@ -3,5 +3,5 @@
 {-# LANGUAGE FlexibleInstances #-}
 --{-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data.Material where
-data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
+data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics
   deriving (Eq,Ord,Show,Bounded,Enum)

src/Dodge/Data/RightButtonOptions.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.RightButtonOptions where
+import Dodge.Equipment.Data
+import Control.Lens
+
+data RightButtonOptions
+    = NoRightButtonOptions
+    | EquipOptions 
+        {_opEquip       :: [EquipPosition]
+        ,_opSel         :: Int
+        ,_opCurInvPos   :: Int
+        ,_opAllocateEquipment :: AllocateEquipment
+        ,_opActivateEquipment :: ActivateEquipment
+        }
+data ActivateEquipment
+    = ActivateEquipment {_activateEquipment :: Int }
+    | DeactivateEquipment {_deactivateEquipment :: Int}
+    | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int}
+    | NoChangeActivateEquipment
+data AllocateEquipment 
+    = DoNotMoveEquipment
+    | PutOnEquipment
+        { _allocNewPos :: EquipPosition
+        }
+    | MoveEquipment
+        { _allocNewPos  :: EquipPosition
+        , _allocOldPos  :: EquipPosition
+        }
+    | SwapEquipment
+        { _allocNewPos  :: EquipPosition
+        , _allocOldPos  :: EquipPosition
+        , _allocSwapID  :: Int
+        }
+    | ReplaceEquipment
+        { _allocNewPos  :: EquipPosition
+        , _allocRemoveID :: Int
+        }
+    | RemoveEquipment
+        { _allocOldPos  :: EquipPosition
+        }
+makeLenses ''RightButtonOptions
+makeLenses ''AllocateEquipment
+makeLenses ''ActivateEquipment

src/Dodge/Data/Sensor.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Sensor where
+import Dodge.Combine.Data
+import Dodge.Data.DamageType
+import Control.Lens
+
+data Sensor = NoSensor
+    | DamageSensor
+        { _sensToggle :: Bool
+        , _sensAmount :: Int
+        , _sensType   :: DamageType
+        }
+    | ProximitySensor
+        { _proxStatus   :: CloseToggle
+        , _proxDist :: Float
+        , _proxRequirement :: ProximityRequirement
+        , _sensToggle :: Bool
+        }
+  deriving (Eq,Ord)
+data ProximityRequirement
+    = RequireHealth {_proxReqMinHealth :: Int}
+    | RequireEquipment {_proxReqEquipment :: ItemBaseType}
+    | RequireImpossible
+  deriving (Eq,Ord,Show)
+data CloseToggle = NotClose | IsClose
+  deriving (Eq,Ord,Show)
+makeLenses ''Sensor
+makeLenses ''ProximityRequirement

src/Dodge/Data/Wall.hs

@@ -19,7 +19,7 @@ data Wall = Wall
     , _wlTouchThrough   :: Bool
     , _wlFireThrough    :: Bool
     , _wlReflect        :: Bool
-    , _wlUnshadowed           :: Bool
+    , _wlUnshadowed     :: Bool
     , _wlRotateTo       :: Bool
     , _wlStructure      :: WallStructure
     , _wlHeight         :: Float

src/Dodge/Debug/Terminal.hs

@@ -4,9 +4,6 @@ module Dodge.Debug.Terminal
 import MaybeHelp
 import Dodge.Inventory.Add
 import Dodge.Creature
-import Dodge.Creature.Damage
---import Dodge.Creature.State
---import Dodge.Creature.YourControl
 import Dodge.Data
 import Dodge.Menu.PushPop
 import Dodge.Item
@@ -40,8 +37,8 @@ applyTerminalCommand s = case s of
     "LT"    -> applyTerminalCommand "LOADTEST"
     ['L',x]     -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
         . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
-    "GODON"     -> uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
+    "GODON"     -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal
-    "GODOFF"    -> uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
+    "GODOFF"    -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh
     "LOADTEST"  -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
         . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
     _ -> id

src/Dodge/Default.hs

@@ -55,8 +55,8 @@ defaultMachine = Machine
     , _mcDir = 0
     , _mcHP = 1000
     , _mcSensor = NoSensor
+    , _mcMaterial = Electronics
     , _mcDamage = []
-    , _mcLSs = []
     , _mcType = StaticMachine
     , _mcName = ""
     , _mcMounts = mempty
@@ -75,7 +75,7 @@ defaultDrawButton col bt =
 defaultTerminal :: Terminal
 defaultTerminal = Terminal 
     { _tmID = 0 
-    , _tmProgram = \_ _ -> []
+    , _tmBootProgram = \_ _ -> []
     , _tmButtonID = 0 
     , _tmMachineID = 0 
     , _tmName = "TESTTERMINAL"

src/Dodge/Default/Creature.hs

@@ -1,7 +1,6 @@
 module Dodge.Default.Creature where
 import Dodge.Data
 import Dodge.Creature.Picture
-import Dodge.Creature.Damage
 import Geometry.Data
 import Picture
 
@@ -19,7 +18,6 @@ defaultCreature = Creature
     , _crMvDir  = 0
     , _crTwist  = 0
     , _crID     = 1
---    , _crPict   = basicCrPict
     , _crType = defaultCreatureSkin
     , _crUpdate = const id
     , _crRad    = 10
@@ -34,7 +32,7 @@ defaultCreature = Creature
     , _crLeftInvSel = Nothing
     , _crState  = defaultState
     , _crCorpse = basicCrCorpse
-    , _crApplyDamage = defaultApplyDamage
+    , _crMaterial = Flesh
     , _crPastDamage = 0
     , _crEquipment = M.empty
     , _crStance = Stance 

src/Dodge/Item/Craftable.hs

@@ -11,10 +11,9 @@ import Control.Lens
 
 makeTypeCraftNum :: Int -> CraftType -> Item
 makeTypeCraftNum i ct = defaultCraftable
-    { _itInvSize = 0.5
+    & itInvSize .~ 0.5
-    , _itCurseStatus = Uncursed
+    & itCurseStatus .~ Uncursed
-    , _itConsumption = ItemItselfConsumable $ IcAmount i
+    & itConsumption .~ ItemItselfConsumable (IcAmount i)
-    }
     & itType . iyBase .~ CRAFT ct
 
 makeTypeCraft :: CraftType -> Item

src/Dodge/Item/Draw/SPic.hs

@@ -11,7 +11,8 @@ import Geometry
 import Data.Maybe
 
 itemSPic :: Item -> SPic
-itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. itType . iyBase of
+itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of
+    CRAFT _ -> defSPic
     HELD ht -> heldItemSPic ht it
     LEFT lt -> leftItemSPic lt it
     EQUIP et -> equipItemSPic et it
@@ -24,7 +25,6 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. it
     KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
 --    
     MEDKIT _  -> defSPic
-    CRAFT _ -> flatShieldEquipSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of
@@ -116,10 +116,10 @@ torchShape =  colorSH blue
     back = upperPrismPoly 3 $ rectXH 1 2
 
 
-modulesSPic :: Item -> ItemModuleType -> SPic -> SPic
+modulesSPic :: Item -> ItemModuleType -> SPic
 modulesSPic it imt = case imt of
-    ATTACHTORCH -> (<> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape))
+    ATTACHTORCH -> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape)
-    _ -> id
+    _ -> mempty
 
 baseStickShapeX :: Item -> Int -> Shape
 baseStickShapeX it i = foldMap f [0..i-1]

src/Dodge/LightSource.hs

@@ -19,7 +19,7 @@ import Geometry.Vector3D
 import Dodge.Default.LightSource
 import LensHelp
 import Dodge.WorldEvent.Sound
-import Dodge.Material
+import Dodge.Material.Sound
 
 lsPosRad :: Point3 -> Float -> LightSource
 lsPosRad = lsColPosRad 0.75

src/Dodge/Machine/Update.hs

@@ -11,13 +11,11 @@ import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Default
 import Dodge.Creature.State
 import Dodge.Creature.Impulse
-import Dodge.Creature.Damage
 import Dodge.Movement.Turn
 import Geometry
 import LensHelp
 import qualified IntMapHelp as IM
 
-import Data.Either
 import Data.List (partition)
 import Data.Maybe
 
@@ -68,7 +66,7 @@ updateTurret rotSpeed mc w
                 & crDir .~ mcdir
                 & crUpdate .~ stateUpdate followThenClearImpulses
                 & crStance . posture .~ Aiming
-                & crApplyDamage .~ applyNoDamage
+                & crMaterial .~ Crystal
         Just cid -> w'
             & creatures . ix cid . crPos .~ mcpos
             & creatures . ix cid . crDir .~ mcdir
@@ -111,7 +109,7 @@ mcTriggerVal :: Machine -> Maybe Bool
 mcTriggerVal mc = case mc ^. mcSensor of
     NoSensor -> Nothing
     s@ProximitySensor{} -> s ^? sensToggle
-    s@SensorToggleAmount{} -> Just $ _sensAmount s > 900
+    s@DamageSensor{} -> Just $ _sensAmount s > 900
     
 mcPlaySound :: Machine -> World -> World
 mcPlaySound mc w = case _mcCloseSound mc of
@@ -131,12 +129,12 @@ mcApplyDamage ds mc = case _mcSensor mc of
 mcSensorUpdate :: Machine -> World -> World
 mcSensorUpdate mc w = case _mcSensor mc of
     NoSensor -> w
-    SensorToggleAmount{} -> foldr (flip sensorUpdate mc . _dmType) w (_mcDamage mc)
+    s@DamageSensor{}  -> senseDamage (_sensType s) mc w
     ProximitySensor{} -> mcProximitySensorUpdate mc w
 
 mcProximitySensorUpdate :: Machine -> World -> World
 mcProximitySensorUpdate mc w = case 
-        (_proxStatus sens
+        ( _proxStatus sens
         , _sensToggle sens
         , mcProxTest mc w 
         , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
@@ -162,21 +160,17 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
   where
     cr = you w
     
-
+senseDamage :: DamageType -> Machine -> World -> World
-sensorUpdate :: DamageType -> Machine -> World -> World
+senseDamage dt mc = (machines . ix mcid %~ upmc)
-sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
+    . updatels
-    & lightSources . ix lsid %~ upls
   where
-    upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
+    upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
-        . ( mcHP -~ sum dam )
-        . (mcDamage .~ [])
-    x = _sensAmount $ _mcSensor mc
     mcid = _mcID mc
-    lsid = head (_mcLSs mc)
+    newsense = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
-    (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
+    ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000
-    newSense = sum senseData
+    updatels = fromMaybe id $ do
-    ni = fromIntegral x / 1000
+        lsid <- mc ^? mcMounts . ix ObLightSource
-    upls = lsParam . lsCol .~ V3 ni ni ni
+        return $ lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
 
 damageUsing :: DamageType -> Damage -> Either Int Int
 damageUsing dt dm

src/Dodge/Material.hs

@@ -1,22 +1 @@
 module Dodge.Material where
-import Dodge.Data.Material
-import Dodge.SoundLogic.ExternallyGeneratedSounds
-import Sound.Data
-
-destroyMatS :: Material -> [SoundID]
-destroyMatS mat = case mat of
-    Glass   -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
-    Crystal -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
-    Stone   -> [stone1S,stone2S,stone3S,stone4S,stone5S]
-    Dirt    -> [stone1S,stone3S]
-    Wood    -> [stone1S,stone3S]
-    Metal   -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]
-
-weakenMatS :: Material -> [SoundID]
-weakenMatS mat = case mat of
-    Glass   -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
-    Crystal -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
-    Stone   -> [stone1S,stone2S,stone3S,stone4S,stone5S]
-    Dirt    -> [stone1S,stone3S]
-    Wood    -> [stone1S,stone3S]
-    Metal   -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]

src/Dodge/Material/Damage.hs

@@ -0,0 +1,81 @@
+module Dodge.Material.Damage where
+import Dodge.Data
+import Dodge.Particle.Spark
+--import Dodge.Particle.Bullet.Spawn
+--import Dodge.Base.Wall
+--import Dodge.Wall.Dust
+--import Dodge.Block
+import Geometry
+--import LensHelp
+
+--import Control.Monad.State
+
+damageMaterial :: Damage -> Material 
+    -> Float -- the angle of the hit surface, in radians
+    -> World -> (Int, World)
+damageMaterial dm mt = case mt of
+    Stone -> damageStone dm
+    _ -> defDamageMaterial dm
+--    Glass -> damageGlass dm
+
+defDamageMaterial :: Damage -> Float -> World -> (Int,World)
+defDamageMaterial dm _ w = (_dmAmount dm, w)
+
+damageStone :: Damage -> Float -> World -> (Int,World)
+damageStone dm dir = case _dmType dm of
+    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (argV $ reflectIn (p -.- sp) v)
+    PIERCING    -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (argV $ reflectIn (p -.- sp) v)
+    BLUNT       -> a d id
+    SHATTERING  -> a d id
+    CRUSHING    -> a d id
+    EXPLOSIVE   -> a d id
+    CUTTING     -> a d id
+    SPARKING    -> a 0 id
+    FLAMING     -> a 0 id
+    ELECTRICAL  -> a 0 id
+    CONCUSSIVE  -> a d id
+    TORQUEDAM   -> a 0 id
+    PUSHDAM     -> a 0 id
+    POISONDAM   -> a 0 id
+    ENTERREMENT -> a 0 id
+  where
+    v = unitVectorAtAngle dir
+    a x f w = (x,f w)
+    d = _dmAmount dm
+    sp = _dmFrom dm
+    p = _dmAt dm
+    outTo = p +.+ squashNormalizeV (sp -.- p)
+    pSparkCol = V4 5 1 0.5 2
+    lSparkCol = V4 20 (-5) 0 1
+    
+--damageGlass :: Damage -> Float -> World -> (World,Int)
+--damageGlass dm dir w = w & case _dmType dm of
+--    LASERING    -> a 0 $ id
+--    PIERCING    -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
+--    BLUNT       -> a d $ dosplint . wlDustAt wl outTo
+--    SHATTERING  -> a d $ dosplint . muchWlDustAt wl outTo
+--    CRUSHING    -> a d dosplint
+--    EXPLOSIVE   -> a d dosplint
+--    CUTTING     -> a d dosplint
+--    SPARKING    -> a 0 id
+--    FLAMING     -> a 0 id
+--    ELECTRICAL  -> a 0 id
+--    CONCUSSIVE  -> a 0 dosplint
+--    TORQUEDAM   -> a 0 id
+--    PUSHDAM     -> a 0 id
+--    POISONDAM   -> a 0 id
+--    ENTERREMENT -> a 0 id
+--  where
+--    mbl = do 
+--        blid <- wl ^? wlStructure . wsBlock
+--        w ^? blocks . ix blid
+--    d :: Int
+--    d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
+--    a :: Int -> (World -> World) -> World -> (World,Int)
+--    a x f w' = (f w',x)
+--    dosplint = maybe id splinterBlock mbl
+--    sp = _dmFrom dm
+--    p = _dmAt dm
+--    outTo = p +.+ squashNormalizeV (sp -.- p)
+--    pSparkCol = V4 5 1 0.5 2
+--    lSparkCol = V4 20 (-5) 0 1

src/Dodge/Material/Sound.hs

@@ -0,0 +1,26 @@
+module Dodge.Material.Sound where
+import Dodge.Data.Material
+import Dodge.SoundLogic.ExternallyGeneratedSounds
+import Sound.Data
+
+destroyMatS :: Material -> [SoundID]
+destroyMatS mat = case mat of
+    Glass   -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
+    Crystal -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
+    Stone   -> [stone1S,stone2S,stone3S,stone4S,stone5S]
+    Dirt    -> [stone1S,stone3S]
+    Wood    -> [stone1S,stone3S]
+    Metal   -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]
+    Electronics -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]
+    Flesh -> [gut1S,gut2S,gut3S,gut4S,gut5S,gut6S]
+
+weakenMatS :: Material -> [SoundID]
+weakenMatS mat = case mat of
+    Glass   -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
+    Crystal -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
+    Stone   -> [stone1S,stone2S,stone3S,stone4S,stone5S]
+    Dirt    -> [stone1S,stone3S]
+    Wood    -> [stone1S,stone3S]
+    Metal   -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]
+    Electronics -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S]
+    Flesh -> [blood1S,blood2S,blood3S,blood4S,blood5S,blood6S,blood7S,blood8S]

src/Dodge/Placement/Instance/Sensor.hs

@@ -16,27 +16,29 @@ import qualified Data.Map.Strict as M
 import Control.Lens
 
 damageSensor
-    :: DamageType -- Left gets sensed, Right does damage
+    :: DamageType
     -> Float
     -> Maybe Int
-    -> PlacementSpot -> Placement
+    -> PlacementSpot 
+    -> Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
     $ \lsid -> Just $ spNoID ps $ PutUsingGenParams 
     $ \gw -> (,) gw $ PutMachine (reverse $ square wdth) $ defaultMachine 
         & mcColor .~ yellow
         & mcMounts . at ObTrigger .~ mtrid
+        & mcMounts . at ObLightSource ?~ lsid
         & mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
-        & mcSensor .~ SensorToggleAmount False 0
+        & mcSensor .~ DamageSensor False 0 dt
-        & mcLSs .~ [lsid]
 
-lightSensor :: Float -- -> (Machine -> World -> World) 
+lightSensor :: Float
     -> Maybe Int
-    -> PlacementSpot -> Placement
+    -> PlacementSpot 
+    -> Placement
 lightSensor = damageSensor LASERING
 
 sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
 sensorSPic wdth (pc,ds) mc = noPic 
-    $ colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth))
+    $  colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth))
-        <> decorationToShape ds wdth wdth 25 col col
+    <> decorationToShape ds wdth wdth 25 col col
   where
     col = paletteToColor pc

src/Dodge/Placement/Instance/Terminal.hs

@@ -94,7 +94,7 @@ accessTerminal mtmid w = case mtmid of
             TerminalReady -> tm
             TerminalBusy -> tm
             TerminalOff -> tm
-                & tmFutureLines .~ _tmProgram tm tm w
+                & tmFutureLines .~ _tmBootProgram tm tm w
                 & tmStatus .~ TerminalBusy
 
 simpleTermMessage :: [String] -> Terminal

src/Dodge/Placement/Instance/Turret.hs

@@ -1,9 +1,7 @@
 module Dodge.Placement.Instance.Turret where
 import Color
 import Dodge.Data
---import Dodge.Reloading
 import Dodge.Creature.State
-import Dodge.Creature.Damage
 import Dodge.Creature.Impulse
 import Dodge.LevelGen.Data
 import Dodge.Default
@@ -76,7 +74,7 @@ updateTurret rotSpeed mc w
                 & crDir .~ mcdir
                 & crUpdate .~ stateUpdate followThenClearImpulses
                 & crStance . posture .~ Aiming
-                & crApplyDamage .~ applyNoDamage
+                & crMaterial .~ Crystal
         Just cid -> w'
             & creatures . ix cid . crPos .~ mcpos
             & creatures . ix cid . crDir .~ mcdir

src/Dodge/Placement/TopDecoration.hs

@@ -6,8 +6,7 @@ import Shape
 import Geometry
 import Color
 
-decorationToShape :: DecorationShape
+decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Color -> Shape
-    -> Float -> Float -> Float -> Color -> Color -> Shape
 decorationToShape dec = case dec of
     PLUS        -> plusDecoration
     SQUARE      -> squareDecoration

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
+import Dodge.Item.Draw.SPic
 import Dodge.Creature.Picture.Awareness
 import Dodge.Creature.Picture
 import Dodge.Particle.Draw
@@ -14,15 +15,12 @@ import Dodge.Picture.SizeInvariant
 import Dodge.Data
 import Dodge.Zone
 import Dodge.Base
---import Dodge.Base.Window
 import Dodge.SoundLogic.LoadSound
 import Dodge.Graph
 import Dodge.GameRoom
 import Dodge.Update.Camera
-import Dodge.Item.Draw
 import Dodge.Render.List
 import Dodge.Path
---import Dodge.Zone
 import Geometry
 import Geometry.Zone
 import ShapePicture
@@ -30,13 +28,10 @@ import Picture
 import Sound.Data
 import Geometry.ConvexPoly
 import ShortShow
---import Dodge.Base.Collide
 
 import StreamingHelp
---import Data.Foldable
 import qualified Data.IntMap.Strict as IM -- Lazy?
 import qualified Data.Map.Strict as M
---import qualified Data.Set as Set
 import Control.Lens
 import Data.Maybe
 import qualified Streaming.Prelude as S
@@ -51,19 +46,18 @@ singleSPic = id
 worldSPic :: Configuration -> World -> SPic
 worldSPic cfig w 
     =  singleSPic (mempty, extraPics cfig w)
-    <> foldup (dbArg _prDraw) (filtOn' _prPos _props)                             
+    <> foldup (dbArg _prDraw) (filtOn _prPos _props)                             
-    <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
+    <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)           
-    <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foregroundShapes)   
+    <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)   
-    <> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
+    <> foldup (dbArg _cpPict) (filtOn _cpPos _corpses)                            
-    <> foldup drawCreature (filtOn' _crPos _creatures)                          
+    <> foldup drawCreature (filtOn _crPos _creatures)                          
-    <> foldup floorItemSPic (filtOn' _flItPos _floorItems)                         
+    <> foldup floorItemSPic (filtOn _flItPos _floorItems)                         
-    <> foldup btSPic (filtOn' _btPos _buttons)                                     
+    <> foldup btSPic (filtOn _btPos _buttons)                                     
-    <> foldup mcSPic (filtOn' _mcPos _machines)                                    
+    <> foldup mcSPic (filtOn _mcPos _machines)                                    
     <> singleSPic (anyTargeting cfig w)
   where
     foldup = foldMap'
-    filtOn' f g = IM.filter (pointIsClose . f) (g w)
+    filtOn f g = IM.filter (pointIsClose . f) (g w)
-    --filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w)
     pointIsClose = cullPoint cfig w
 
 anyTargeting :: Configuration -> World -> SPic
@@ -157,11 +151,9 @@ drawPathBetween w = setLayer DebugLayer
     ep = _rSelect w
 
 drawNodesNearSelect :: World -> Picture
-drawNodesNearSelect w = setLayer DebugLayer $
+drawNodesNearSelect w = setLayer DebugLayer 
-     runIdentity (S.foldMap_ (drawZone pnZoneSize) (zoneAroundPoint pnZoneSize sp))
+    $  runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
---    <> color red (foldMap (drawCross . snd) $ nodesNearL sp w)
     <> color green (drawCross sp)
---    <> color cyan (foldMap (drawCross . snd) $ walkableNodeNear sp w)
   where
     sp = _lSelect w
 
@@ -173,10 +165,8 @@ drawInspectWalls w = foldMap (drawInspectWall w)
     (a,b) = _lLine w
 
 drawInspectWall :: World -> Wall -> Picture
-drawInspectWall w wl = setLayer DebugLayer $ 
+drawInspectWall w wl = setLayer DebugLayer
-        color rose (thickLine 3 [a,b])
+    $  color rose (thickLine 3 [a,b])
---    <> foldMap (drawZone wlZoneSize)
---        (runIdentity $ S.toList_ $ zoneOfWall wlZoneSize wl)  -- this won't work if wlZoneSize is not consistent
     <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor)
   where
     (a,b) = _wlLine wl 
@@ -217,8 +207,8 @@ drawFarWallDetect w = setLayer DebugLayer
     p = _cameraViewFrom w
 
 drawDDATest :: World -> Picture
-drawDDATest w = runIdentity (S.foldMap_ (drawZone 50) ps)
+drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
-    <> runIdentity (S.foldMap_ (drawZone' 50) ps')
+    <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
     <> runIdentity (S.foldMap_ drawCross qs)
     <> color blue (runIdentity (S.foldMap_ drawCross qs'))
     <> setLayer DebugLayer (color yellow (line [cvf,mwp]))
@@ -236,15 +226,11 @@ drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic
 crossPic :: Float -> Picture
 crossPic x = line [V2 x x,V2 (-x) (-x)] <> line [V2 (-x) x,V2 x (-x)]
 
-drawZone :: Float -> V2 Int -> Picture
+drawZoneCol :: Color -> Float -> V2 Int -> Picture
-drawZone s (V2 x y) = setLayer DebugLayer . color orange $ thickLine 2 (p:ps ++ [p])
+drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p:ps ++ [p])
   where
-    (p:ps) = zipWith (+.+) innerSquare $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)]
+    (p:ps) = zipWith (+.+) innerSquare 
-
+        $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)]
-drawZone' :: Float -> V2 Int -> Picture
-drawZone' s (V2 x y) = setLayer DebugLayer . color green $ line (p:ps ++ [p])
-  where
-    (p:ps) = zipWith (+.+) (map (2*.*) innerSquare) $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)]
 
 innerSquare :: [Point2]
 innerSquare = [V2 1 1, V2 (-1) 1, V2 (-1) (-1), V2 1 (-1)]
@@ -267,10 +253,9 @@ clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (_clPict c c)
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
-
 floorItemSPic :: FloorItem -> SPic
 floorItemSPic flit = uncurryV translateSPf (_flItPos flit)
-    $ rotateSP (_flItRot flit)  (itemSPic (_flIt flit))
+    $ rotateSP (_flItRot flit) (itemSPic (_flIt flit))
 
 btSPic :: Button -> SPic
 btSPic bt = uncurryV translateSPf (_btPos bt)

src/Dodge/Room/Warning.hs

@@ -2,31 +2,18 @@
 module Dodge.Room.Warning where
 import Dodge.Cleat
 import Dodge.Terminal
---import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
 import Dodge.Placement.Instance.Terminal
 import Dodge.Data
 import Dodge.Tree
---import Dodge.RoomLink
 import Dodge.Room.Door
 import Dodge.Room.Ngon
 import Dodge.Room.Procedural
 import Dodge.Room.Tanks
---import Dodge.Room.Corridor
 import Dodge.Room.Link
---import Dodge.Room.Procedural
---import Dodge.Room.Foreground
---import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
---import Dodge.Default.Room
---import Dodge.Item.Weapon.Utility
---import Dodge.LevelGen.Data
---import Geometry.Data
 import Geometry
---import Padding
+import Color
---import Color
---import Shape
---import Lorem
 import LensHelp
 import RandomHelp
 
@@ -54,8 +41,7 @@ addWarningTerminal str outplid = (rmName .++~ "warningTerm-")
         (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
         (Just . set plSpot (rprShift moveToSideFirstOutLink) 
             . putMessageTerminal terminalColor . termMessages)
-    termMessages trpl = basicTerminal 
+    termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str)
-        & tmFutureLines .~ makeTermPara str
         & tmScrollCommands .:~ toggleCommand
         & tmToggles .~ M.fromList 
             [("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const (const True)))]

src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs

@@ -1,4 +1,4 @@
--- generated at 2022-06-23 20:14:52.284399733 UTC
+-- generated at 2022-07-14 22:58:49.919236742 UTC
 module Dodge.SoundLogic.ExternallyGeneratedSounds where
 import Sound.Data
 soundToVol :: SoundID -> Float
@@ -11,85 +11,99 @@ soundToVol v = case _getSoundID v of
     5 -> 1000
     6 -> 40
     7 -> 100
-    8 -> 500
+    8 -> 100
     9 -> 500
-    10 -> 300
+    10 -> 200
     11 -> 500
-    12 -> 1000
+    12 -> 300
-    13 -> 40
+    13 -> 100
-    14 -> 2000
+    14 -> 500
-    15 -> 50
+    15 -> 1000
-    16 -> 50
+    16 -> 40
     17 -> 2000
-    18 -> 200
+    18 -> 100
-    19 -> 40
+    19 -> 50
-    20 -> 300
+    20 -> 200
-    21 -> 500
+    21 -> 50
     22 -> 2000
-    23 -> 500
+    23 -> 200
-    24 -> 100
+    24 -> 40
-    25 -> 1000
+    25 -> 300
-    26 -> 100
+    26 -> 500
-    27 -> 1000
+    27 -> 2000
-    28 -> 1000
+    28 -> 500
-    29 -> 40
+    29 -> 100
-    30 -> 2000
+    30 -> 200
-    31 -> 50
+    31 -> 1000
-    32 -> 2000
+    32 -> 100
-    33 -> 50
+    33 -> 100
     34 -> 1000
-    35 -> 8000
+    35 -> 1000
-    36 -> 2000
+    36 -> 40
     37 -> 2000
-    38 -> 1000
+    38 -> 100
-    39 -> 2000
+    39 -> 50
-    40 -> 100
+    40 -> 2000
-    41 -> 40
+    41 -> 50
-    42 -> 40
+    42 -> 1000
-    43 -> 2000
+    43 -> 8000
-    44 -> 100
+    44 -> 2000
-    45 -> 500
+    45 -> 2000
-    46 -> 40
+    46 -> 1000
-    47 -> 300
+    47 -> 2000
-    48 -> 300
+    48 -> 100
-    49 -> 2000
+    49 -> 40
-    50 -> 1000
+    50 -> 40
-    51 -> 1000
+    51 -> 2000
-    52 -> 1000
+    52 -> 100
-    53 -> 1000
+    53 -> 500
-    54 -> 1000
+    54 -> 40
-    55 -> 40
+    55 -> 300
-    56 -> 50
+    56 -> 300
-    57 -> 1000
+    57 -> 2000
-    58 -> 500
+    58 -> 1000
-    59 -> 500
+    59 -> 1000
     60 -> 1000
-    61 -> 20
+    61 -> 1000
-    62 -> 500
+    62 -> 1000
-    63 -> 300
+    63 -> 40
-    64 -> 500
+    64 -> 50
     65 -> 1000
-    66 -> 1000
+    66 -> 500
     67 -> 500
-    68 -> 1000
+    68 -> 100
-    69 -> 2000
+    69 -> 1000
-    70 -> 2000
+    70 -> 20
     71 -> 500
-    72 -> 2000
+    72 -> 300
-    73 -> 100
+    73 -> 200
-    74 -> 300
+    74 -> 500
     75 -> 1000
-    76 -> 100
+    76 -> 1000
-    77 -> 1000
+    77 -> 500
-    78 -> 2000
+    78 -> 100
     79 -> 1000
-    80 -> 200
+    80 -> 2000
-    81 -> 500
+    81 -> 2000
-    82 -> 100
+    82 -> 500
     83 -> 2000
-    84 -> 2000
+    84 -> 100
-    85 -> 2000
+    85 -> 300
-    86 -> 100
+    86 -> 1000
+    87 -> 200
+    88 -> 100
+    89 -> 1000
+    90 -> 2000
+    91 -> 1000
+    92 -> 100
+    93 -> 200
+    94 -> 500
+    95 -> 100
+    96 -> 2000
+    97 -> 2000
+    98 -> 2000
+    99 -> 100
+    100 -> 200
     _ -> 50
 soundToOnomato :: SoundID -> String
 soundToOnomato v = case _getSoundID v of
@@ -100,86 +114,100 @@ soundToOnomato v = case _getSoundID v of
     4 -> "DEDEDA"
     5 -> "CRNK"
     6 -> "CLNK"
-    7 -> "WRR"
+    7 -> "SKWLCH"
-    8 -> "TINKLE"
+    8 -> "WRR"
-    9 -> "TRINKL"
+    9 -> "TINKLE"
-    10 -> "BWAAH"
+    10 -> "SKREL"
-    11 -> "DNDNDNDN"
+    11 -> "TRINKL"
-    12 -> "CRMBL"
+    12 -> "BWAAH"
-    13 -> "TIP"
+    13 -> "SQLEE"
-    14 -> "TATATA"
+    14 -> "DNDNDNDN"
-    15 -> "BLIH"
+    15 -> "CRMBL"
-    16 -> "HMM"
+    16 -> "TIP"
-    17 -> "PEW"
+    17 -> "TATATA"
-    18 -> "CRAKLE"
+    18 -> "SPRT"
-    19 -> "TAP"
+    19 -> "BLIH"
-    20 -> "DWAAH"
+    20 -> "SQWCH"
-    21 -> "PRUM"
+    21 -> "HMM"
-    22 -> "BANGG"
+    22 -> "PEW"
-    23 -> "CRTINK"
+    23 -> "CRAKLE"
-    24 -> "PHF"
+    24 -> "TAP"
-    25 -> "ZHM"
+    25 -> "DWAAH"
-    26 -> "THUD"
+    26 -> "PRUM"
-    27 -> "TRWNG"
+    27 -> "BANGG"
-    28 -> "CRASH"
+    28 -> "CRTINK"
-    29 -> "TAPTIP"
+    29 -> "PHF"
-    30 -> "CHUGUGUG"
+    30 -> "CRNCH"
-    31 -> "HSSS"
+    31 -> "ZHM"
-    32 -> "BOOM"
+    32 -> "CLCLH"
-    33 -> "HSS"
+    33 -> "THUD"
-    34 -> "TAKH"
+    34 -> "TRWNG"
-    35 -> "RINGGG"
+    35 -> "CRASH"
-    36 -> "CRH"
+    36 -> "TAPTIP"
-    37 -> "UGGAUGGA"
+    37 -> "CHUGUGUG"
-    38 -> "CRUMPLE"
+    38 -> "SKWLL"
-    39 -> "CREUH"
+    39 -> "HSSS"
-    40 -> "SMACK"
+    40 -> "BOOM"
-    41 -> "CLICK"
+    41 -> "HSS"
-    42 -> "TIPTOP"
+    42 -> "TAKH"
-    43 -> "CRUH"
+    43 -> "RINGGG"
-    44 -> "CHNKCHNKCHUNK"
+    44 -> "CRH"
-    45 -> "CLKCLK"
+    45 -> "UGGAUGGA"
-    46 -> "TIPTAP"
+    46 -> "CRUMPLE"
-    47 -> "TNKTNKTNK"
+    47 -> "CREUH"
-    48 -> "CHPCHPCHP"
+    48 -> "SMACK"
-    49 -> "SCREE"
+    49 -> "CLICK"
-    50 -> "DHDHL"
+    50 -> "TIPTOP"
-    51 -> "BRAP"
+    51 -> "CRUH"
-    52 -> "CRSK"
+    52 -> "CHNKCHNKCHUNK"
-    53 -> "CRNKL"
+    53 -> "CLKCLK"
-    54 -> "TRNKL"
+    54 -> "TIPTAP"
-    55 -> "TAPP"
+    55 -> "TNKTNKTNK"
-    56 -> "SHUHP"
+    56 -> "CHPCHPCHP"
-    57 -> "CRUMBL"
+    57 -> "SCREE"
-    58 -> "DEDEDUM"
+    58 -> "DHDHL"
-    59 -> "TAK"
+    59 -> "BRAP"
-    60 -> "CRISH"
+    60 -> "CRSK"
-    61 -> "SWSH"
+    61 -> "CRNKL"
-    62 -> "BIPBIPBIP"
+    62 -> "TRNKL"
-    63 -> "BEP"
+    63 -> "TAPP"
-    64 -> "KRTNKL"
+    64 -> "SHUHP"
-    65 -> "CRSNK"
+    65 -> "CRUMBL"
-    66 -> "TTRKL"
+    66 -> "DEDEDUM"
-    67 -> "DUDURAH"
+    67 -> "TAK"
-    68 -> "CRMPL"
+    68 -> "SPLRT"
-    69 -> "CHUGUGUG"
+    69 -> "CRISH"
-    70 -> "BANG"
+    70 -> "SWSH"
-    71 -> "DEDA"
+    71 -> "BIPBIPBIP"
-    72 -> "WHSSH"
+    72 -> "BEP"
-    73 -> "HNH"
+    73 -> "CRSKRL"
-    74 -> "BWAH"
+    74 -> "KRTNKL"
-    75 -> "CRUNK"
+    75 -> "CRSNK"
-    76 -> "DRR"
+    76 -> "TTRKL"
-    77 -> "TRNKL"
+    77 -> "DUDURAH"
-    78 -> "BRAP"
+    78 -> "KKSQWL"
-    79 -> "BLPCHCH"
+    79 -> "CRMPL"
-    80 -> "ZMM"
+    80 -> "CHUGUGUG"
-    81 -> "WRRR"
+    81 -> "BANG"
-    82 -> "FWUMP"
+    82 -> "DEDA"
-    83 -> "BRAHCHCH"
+    83 -> "WHSSH"
-    84 -> "BRPBRPBRP"
+    84 -> "HNH"
-    85 -> "WE-OH"
+    85 -> "BWAH"
-    86 -> "FHP"
+    86 -> "CRUNK"
+    87 -> "SQWLTCH"
+    88 -> "DRR"
+    89 -> "TRNKL"
+    90 -> "BRAP"
+    91 -> "BLPCHCH"
+    92 -> "SKLE"
+    93 -> "ZMM"
+    94 -> "WRRR"
+    95 -> "FWUMP"
+    96 -> "BRAHCHCH"
+    97 -> "BRPBRPBRP"
+    98 -> "WE-OH"
+    99 -> "FHP"
+    100 -> "QWLPH"
     _ -> error "unitialised sound"
 soundPathList :: [String]
 soundPathList =
@@ -190,15 +218,20 @@ soundPathList =
     , "dededa.DEDEDA.500.wav"
     , "glassShat3.CRNK.1000.wav"
     , "tapQuiet.CLNK.40.wav"
+    , "blood8.SKWLCH.100.wav"
     , "fire.WRR.100.wav"
     , "smallGlass4.TINKLE.500.wav"
+    , "gut4.SKREL.200.wav"
     , "smallGlass1.TRINKL.500.wav"
     , "sineRaisePitchTwoSec.BWAAH.300.wav"
+    , "blood7.SQLEE.100.wav"
     , "combine.DNDNDNDN.500.wav"
     , "stone4.CRMBL.1000.wav"
     , "foot1.TIP.40.wav"
     , "autoB.TATATA.2000.wav"
+    , "blood2.SPRT.100.wav"
     , "heal.BLIH.50.wav"
+    , "gut3.SQWCH.200.wav"
     , "fridgeHum.HMM.50.wav"
     , "seagullWhistle1.PEW.2000.wav"
     , "elecCrackle.CRAKLE.200.wav"
@@ -208,12 +241,15 @@ soundPathList =
     , "bangEcho.BANGG.2000.wav"
     , "smallGlass3.CRTINK.500.wav"
     , "whiteNoiseFadeOut.PHF.100.wav"
+    , "gut2.CRNCH.200.wav"
     , "tele.ZHM.1000.wav"
+    , "blood5.CLCLH.100.wav"
     , "hit.THUD.100.wav"
     , "metal7.TRWNG.1000.wav"
     , "stone1.CRASH.1000.wav"
     , "twoStep1.TAPTIP.40.wav"
     , "seagullChatter.CHUGUGUG.2000.wav"
+    , "blood4.SKWLL.100.wav"
     , "foamSprayLoop.HSSS.50.wav"
     , "explosion.BOOM.2000.wav"
     , "foamSprayFadeOut.HSS.50.wav"
@@ -243,14 +279,17 @@ soundPathList =
     , "stone5.CRUMBL.1000.wav"
     , "dededum.DEDEDUM.500.wav"
     , "tap1.TAK.500.wav"
+    , "blood1.SPLRT.100.wav"
     , "metal4.CRISH.1000.wav"
     , "knife.SWSH.20.wav"
     , "computerBeeping.BIPBIPBIP.500.wav"
     , "tone440.BEP.300.wav"
+    , "gut6.CRSKRL.200.wav"
     , "smallGlass2.KRTNKL.500.wav"
     , "glassShat1.CRSNK.1000.wav"
     , "metal5.TTRKL.1000.wav"
     , "eject.DUDURAH.500.wav"
+    , "blood3.KKSQWL.100.wav"
     , "stone2.CRMPL.1000.wav"
     , "seagullChatter1.CHUGUGUG.2000.wav"
     , "bang.BANG.2000.wav"
@@ -259,10 +298,12 @@ soundPathList =
     , "grunt.HNH.100.wav"
     , "sineRaisePitchOneSec.BWAH.300.wav"
     , "metal2.CRUNK.1000.wav"
+    , "gut5.SQWLTCH.200.wav"
     , "slideDoor.DRR.100.wav"
     , "metal6.TRNKL.1000.wav"
     , "autoGun.BRAP.2000.wav"
     , "oldMachineBoot.BLPCHCH.1000.wav"
+    , "blood6.SKLE.100.wav"
     , "buzz.ZMM.200.wav"
     , "fireLoud.WRRR.500.wav"
     , "tap4.FWUMP.100.wav"
@@ -270,6 +311,7 @@ soundPathList =
     , "mini.BRPBRPBRP.2000.wav"
     , "seagullWhistle.WE-OH.2000.wav"
     , "whiteNoiseFadeIn.FHP.100.wav"
+    , "gut1.QWLPH.200.wav"
     ]
 dedumS :: SoundID
 dedumS = SoundID 0
@@ -285,163 +327,191 @@ glassShat3S :: SoundID
 glassShat3S = SoundID 5
 tapQuietS :: SoundID
 tapQuietS = SoundID 6
+blood8S :: SoundID
+blood8S = SoundID 7
 fireS :: SoundID
-fireS = SoundID 7
+fireS = SoundID 8
 smallGlass4S :: SoundID
-smallGlass4S = SoundID 8
+smallGlass4S = SoundID 9
+gut4S :: SoundID
+gut4S = SoundID 10
 smallGlass1S :: SoundID
-smallGlass1S = SoundID 9
+smallGlass1S = SoundID 11
 sineRaisePitchTwoSecS :: SoundID
-sineRaisePitchTwoSecS = SoundID 10
+sineRaisePitchTwoSecS = SoundID 12
+blood7S :: SoundID
+blood7S = SoundID 13
 combineS :: SoundID
-combineS = SoundID 11
+combineS = SoundID 14
 stone4S :: SoundID
-stone4S = SoundID 12
+stone4S = SoundID 15
 foot1S :: SoundID
-foot1S = SoundID 13
+foot1S = SoundID 16
 autoBS :: SoundID
-autoBS = SoundID 14
+autoBS = SoundID 17
+blood2S :: SoundID
+blood2S = SoundID 18
 healS :: SoundID
-healS = SoundID 15
+healS = SoundID 19
+gut3S :: SoundID
+gut3S = SoundID 20
 fridgeHumS :: SoundID
-fridgeHumS = SoundID 16
+fridgeHumS = SoundID 21
 seagullWhistle1S :: SoundID
-seagullWhistle1S = SoundID 17
+seagullWhistle1S = SoundID 22
 elecCrackleS :: SoundID
-elecCrackleS = SoundID 18
+elecCrackleS = SoundID 23
 foot2S :: SoundID
-foot2S = SoundID 19
+foot2S = SoundID 24
 skwareFadeTwoSecS :: SoundID
-skwareFadeTwoSecS = SoundID 20
+skwareFadeTwoSecS = SoundID 25
 insertOneS :: SoundID
-insertOneS = SoundID 21
+insertOneS = SoundID 26
 bangEchoS :: SoundID
-bangEchoS = SoundID 22
+bangEchoS = SoundID 27
 smallGlass3S :: SoundID
-smallGlass3S = SoundID 23
+smallGlass3S = SoundID 28
 whiteNoiseFadeOutS :: SoundID
-whiteNoiseFadeOutS = SoundID 24
+whiteNoiseFadeOutS = SoundID 29
+gut2S :: SoundID
+gut2S = SoundID 30
 teleS :: SoundID
-teleS = SoundID 25
+teleS = SoundID 31
+blood5S :: SoundID
+blood5S = SoundID 32
 hitS :: SoundID
-hitS = SoundID 26
+hitS = SoundID 33
 metal7S :: SoundID
-metal7S = SoundID 27
+metal7S = SoundID 34
 stone1S :: SoundID
-stone1S = SoundID 28
+stone1S = SoundID 35
 twoStep1S :: SoundID
-twoStep1S = SoundID 29
+twoStep1S = SoundID 36
 seagullChatterS :: SoundID
-seagullChatterS = SoundID 30
+seagullChatterS = SoundID 37
+blood4S :: SoundID
+blood4S = SoundID 38
 foamSprayLoopS :: SoundID
-foamSprayLoopS = SoundID 31
+foamSprayLoopS = SoundID 39
 explosionS :: SoundID
-explosionS = SoundID 32
+explosionS = SoundID 40
 foamSprayFadeOutS :: SoundID
-foamSprayFadeOutS = SoundID 33
+foamSprayFadeOutS = SoundID 41
 tap2S :: SoundID
-tap2S = SoundID 34
+tap2S = SoundID 42
 tinitusS :: SoundID
-tinitusS = SoundID 35
+tinitusS = SoundID 43
 seagullCry1S :: SoundID
-seagullCry1S = SoundID 36
+seagullCry1S = SoundID 44
 seagullBarkS :: SoundID
-seagullBarkS = SoundID 37
+seagullBarkS = SoundID 45
 stone3S :: SoundID
-stone3S = SoundID 38
+stone3S = SoundID 46
 seagullCry2S :: SoundID
-seagullCry2S = SoundID 39
+seagullCry2S = SoundID 47
 hit1S :: SoundID
-hit1S = SoundID 40
+hit1S = SoundID 48
 click1S :: SoundID
-click1S = SoundID 41
+click1S = SoundID 49
 twoStepSlowS :: SoundID
-twoStepSlowS = SoundID 42
+twoStepSlowS = SoundID 50
 seagullCryS :: SoundID
-seagullCryS = SoundID 43
+seagullCryS = SoundID 51
 crankSlowS :: SoundID
-crankSlowS = SoundID 44
+crankSlowS = SoundID 52
 primeS :: SoundID
-primeS = SoundID 45
+primeS = SoundID 53
 twoStepS :: SoundID
-twoStepS = SoundID 46
+twoStepS = SoundID 54
 reloadS :: SoundID
-reloadS = SoundID 47
+reloadS = SoundID 55
 reload1S :: SoundID
-reload1S = SoundID 48
+reload1S = SoundID 56
 tone440sawtoothS :: SoundID
-tone440sawtoothS = SoundID 49
+tone440sawtoothS = SoundID 57
 metal3S :: SoundID
-metal3S = SoundID 50
+metal3S = SoundID 58
 tap3S :: SoundID
-tap3S = SoundID 51
+tap3S = SoundID 59
 glassShat4S :: SoundID
-glassShat4S = SoundID 52
+glassShat4S = SoundID 60
 glassShat2S :: SoundID
-glassShat2S = SoundID 53
+glassShat2S = SoundID 61
 metal1S :: SoundID
-metal1S = SoundID 54
+metal1S = SoundID 62
 foot3S :: SoundID
-foot3S = SoundID 55
+foot3S = SoundID 63
 pickUpS :: SoundID
-pickUpS = SoundID 56
+pickUpS = SoundID 64
 stone5S :: SoundID
-stone5S = SoundID 57
+stone5S = SoundID 65
 dededumS :: SoundID
-dededumS = SoundID 58
+dededumS = SoundID 66
 tap1S :: SoundID
-tap1S = SoundID 59
+tap1S = SoundID 67
+blood1S :: SoundID
+blood1S = SoundID 68
 metal4S :: SoundID
-metal4S = SoundID 60
+metal4S = SoundID 69
 knifeS :: SoundID
-knifeS = SoundID 61
+knifeS = SoundID 70
 computerBeepingS :: SoundID
-computerBeepingS = SoundID 62
+computerBeepingS = SoundID 71
 tone440S :: SoundID
-tone440S = SoundID 63
+tone440S = SoundID 72
+gut6S :: SoundID
+gut6S = SoundID 73
 smallGlass2S :: SoundID
-smallGlass2S = SoundID 64
+smallGlass2S = SoundID 74
 glassShat1S :: SoundID
-glassShat1S = SoundID 65
+glassShat1S = SoundID 75
 metal5S :: SoundID
-metal5S = SoundID 66
+metal5S = SoundID 76
 ejectS :: SoundID
-ejectS = SoundID 67
+ejectS = SoundID 77
+blood3S :: SoundID
+blood3S = SoundID 78
 stone2S :: SoundID
-stone2S = SoundID 68
+stone2S = SoundID 79
 seagullChatter1S :: SoundID
-seagullChatter1S = SoundID 69
+seagullChatter1S = SoundID 80
 bangS :: SoundID
-bangS = SoundID 70
+bangS = SoundID 81
 dedaS :: SoundID
-dedaS = SoundID 71
+dedaS = SoundID 82
 missileLaunchS :: SoundID
-missileLaunchS = SoundID 72
+missileLaunchS = SoundID 83
 gruntS :: SoundID
-gruntS = SoundID 73
+gruntS = SoundID 84
 sineRaisePitchOneSecS :: SoundID
-sineRaisePitchOneSecS = SoundID 74
+sineRaisePitchOneSecS = SoundID 85
 metal2S :: SoundID
-metal2S = SoundID 75
+metal2S = SoundID 86
+gut5S :: SoundID
+gut5S = SoundID 87
 slideDoorS :: SoundID
-slideDoorS = SoundID 76
+slideDoorS = SoundID 88
 metal6S :: SoundID
-metal6S = SoundID 77
+metal6S = SoundID 89
 autoGunS :: SoundID
-autoGunS = SoundID 78
+autoGunS = SoundID 90
 oldMachineBootS :: SoundID
-oldMachineBootS = SoundID 79
+oldMachineBootS = SoundID 91
+blood6S :: SoundID
+blood6S = SoundID 92
 buzzS :: SoundID
-buzzS = SoundID 80
+buzzS = SoundID 93
 fireLoudS :: SoundID
-fireLoudS = SoundID 81
+fireLoudS = SoundID 94
 tap4S :: SoundID
-tap4S = SoundID 82
+tap4S = SoundID 95
 shotgunS :: SoundID
-shotgunS = SoundID 83
+shotgunS = SoundID 96
 miniS :: SoundID
-miniS = SoundID 84
+miniS = SoundID 97
 seagullWhistleS :: SoundID
-seagullWhistleS = SoundID 85
+seagullWhistleS = SoundID 98
 whiteNoiseFadeInS :: SoundID
-whiteNoiseFadeInS = SoundID 86
+whiteNoiseFadeInS = SoundID 99
+gut1S :: SoundID
+gut1S = SoundID 100

src/Dodge/Terminal.hs

@@ -229,7 +229,7 @@ basicTerminal = defaultTerminal
     ,_tmInput   = defaultTerminalInput
     ,_tmScrollCommands = [quitCommand]
     ,_tmWriteCommands = [helpCommand,commandsCommand]
-    ,_tmProgram = \_ _ -> connectionBlurb
+    ,_tmBootProgram = \_ _ -> connectionBlurb
     , _tmDeathEffect = doDeathTriggers
     }
 
@@ -242,7 +242,7 @@ lineOutputTerminal tls = defaultTerminal
     ,_tmInput   = defaultTerminalInput
     ,_tmScrollCommands = [quitCommand]
     ,_tmWriteCommands = [helpCommand,commandsCommand]
-    ,_tmProgram = \_ _ -> connectionBlurbLines tls
+    ,_tmBootProgram = \_ _ -> connectionBlurbLines tls
     , _tmDeathEffect = doDeathTriggers
     }
 

src/Dodge/Wall/DamageEffect.hs

@@ -19,11 +19,12 @@ defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial w
     Crystal -> crystalWallDamage dm wl
     Metal   -> stoneWallDamage dm wl
     Wood    -> stoneWallDamage dm wl
+    Electronics -> stoneWallDamage dm wl
+    Flesh -> stoneWallDamage dm wl
 
 stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
 stoneWallDamage dm wl = case _dmType dm of
     LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
---    LASERING    -> a 0 $ id
     PIERCING    -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> a d $ wlDustAt wl outTo
     SHATTERING  -> a d $ muchWlDustAt wl outTo