Add file

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,8 +2,10 @@ module Dodge.Creature.Impulse.UseItem (
     useItem,
     doTopInvLeftClick,
     itemEffect,
+    tryUseL,
 ) where
 
+import Dodge.Hotkey
 import Control.Lens
 import Control.Monad
 import Data.Foldable
@@ -50,7 +52,6 @@ itemEffect cr it w = case it ^. itUse of
         setuhamdown $
             hammerTest
                 ( toggleEquipmentAt (_rbOptions w) itRef cr
-                    . activateEquipmentAt (_rbOptions w) cr
                 )
 
 tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
@@ -68,13 +69,6 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
   where
     ic = _heldConsumption (_itUse it)
 
-activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
-activateEquipmentAt rbo cr =
-    cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
-        (Just i, _) -> crLeftInvSel . lisMPos ?~ i
-        (_, Just _) -> crLeftInvSel . lisMPos .~ Nothing
-        _ -> id
-
 toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
 toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     Just DoNotMoveEquipment -> w
@@ -83,6 +77,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & onequip itm cr
+            & crpoint %~ assignNewHotkey invid
     Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
@@ -101,27 +96,26 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
             & crpoint . crInvEquipped . at rid .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
+            & crpoint %~ removeHotkey rid
+            & crpoint %~ assignNewHotkey invid
     Just RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid .~ Nothing
             & onremove itm cr
+            & crpoint %~ removeHotkey invid
     Nothing -> error "tried to toggle equipment when not prepared"
   where
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
     itmat i = _crInv cr IM.! i
     itm = itmat itRef
-    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
+    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change?
     onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
     onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
 
 doTopInvLeftClick :: Creature -> World -> World
 doTopInvLeftClick cr w = fromMaybe w $ do
     guard . not $ _crInvLock cr
-    return $ doTopInvLeftClick' cr w
-
-doTopInvLeftClick' :: Creature -> World -> World
-doTopInvLeftClick' cr w = fromMaybe (doTopInvLeftClickSearch cr w) $ do
     invid <- cr ^? crManipulation . manObject . inInventory . ispItem
     ituse <- cr ^? crInv . ix invid . itUse
     case ituse of
@@ -136,11 +130,6 @@ equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
         | otherwise -> useItem cr w
     _ -> tryUseL (_crID cr) invid w
 
-doTopInvLeftClickSearch :: Creature -> World -> World
-doTopInvLeftClickSearch cr w = fromMaybe w $ do
-    invid <- cr ^. crLeftInvSel . lisMPos
-    return $ tryUseL (_crID cr) invid w
-
 tryUseL :: Int -> Int -> World -> World
 tryUseL crid invid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix crid

src/Dodge/Creature/ReaderUpdate.hs

@@ -56,7 +56,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
     mtpos = do
         tpos <- _crPos <$> _targetCr int
         guard $ hasLOSIndirect (_crPos cr) tpos w
-        return $ tpos
+        return tpos
     mpos = mtpos <|> _mvToPoint int
 
 setViewPos :: World -> Creature -> Creature
@@ -67,7 +67,7 @@ setViewPos w cr = cr & crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPo
 attentionViewPoint :: World -> Creature -> Maybe Point2
 attentionViewPoint w cr = do
     attention <- cr ^? crPerception . cpAttention . getAttentiveTo
-    cid <- (sortOn snd $ IM.toList attention) ^? ix 0 . _1
+    cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
     tcr <- w ^? cWorld . lWorld . creatures . ix cid
     guard $ visionCheck cr (_crPos tcr) > 0
     return (_crPos tcr)

src/Dodge/Creature/YourControl.hs

@@ -2,16 +2,19 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import Dodge.WASD
-import Dodge.Base.You
 import Dodge.Creature.Impulse.UseItem
+import Dodge.Hotkey
+import Control.Monad
+import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Coordinate
+import Dodge.Base.You
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Test
 import Dodge.Data.World
 import Dodge.InputFocus
+import Dodge.WASD
 import Geometry
 import LensHelp
 import qualified SDL
@@ -20,13 +23,15 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl cr w
     | inInputFocus w = w
-    | not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
+    | not intopinv =
-                %~ wasdWithAiming w (_mvSpeed $ _crMvType cr)    
+        w & cWorld . lWorld . creatures . ix (_crID cr)
+            %~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
     | otherwise =
         w
             & cWorld . lWorld . creatures . ix (_crID cr)
                 %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
             & pressedMBEffectsTopInventory pkeys
+            & handleHotkeys
   where
     pkeys = w ^. input . mouseButtons
     intopinv = fromMaybe False $ do
@@ -35,12 +40,60 @@ yourControl cr w
             NoSubInventory -> True
             _ -> False
 
---dimCreatureLight :: Creature -> World -> World
+handleHotkeys :: World -> World
---dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
+handleHotkeys w
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = foldl' tryAssignHotkey w allHotkeys
+    | otherwise = foldl' useHotKey w (M.intersection hotkeys (w ^. input . pressedKeys))
+  where
+    hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
 
--- note the order of operation, setting the posture first--this prevents the twist fire bug
+useHotKey :: World -> Int -> World
+useHotKey w invid = tryUseL 0 invid w
+
+allHotkeys :: [SDL.Scancode]
+allHotkeys = map hotkeyToScancode [minBound .. maxBound]
+
+hotkeyToScancode :: Hotkey -> SDL.Scancode
+hotkeyToScancode x = case x of
+    HotkeyQ -> SDL.ScancodeQ
+    HotkeyE -> SDL.ScancodeE
+    Hotkey1 -> SDL.Scancode1
+    Hotkey2 -> SDL.Scancode2
+    Hotkey3 -> SDL.Scancode3
+    Hotkey4 -> SDL.Scancode4
+    Hotkey5 -> SDL.Scancode5
+    Hotkey6 -> SDL.Scancode6
+    Hotkey7 -> SDL.Scancode7
+    Hotkey8 -> SDL.Scancode8
+    Hotkey9 -> SDL.Scancode9
+    Hotkey0 -> SDL.Scancode0
+
+scancodeToHotkey :: SDL.Scancode -> Hotkey
+scancodeToHotkey x = case x of
+    SDL.ScancodeQ -> HotkeyQ
+    SDL.ScancodeE -> HotkeyE
+    SDL.Scancode1 -> Hotkey1
+    SDL.Scancode2 -> Hotkey2
+    SDL.Scancode3 -> Hotkey3
+    SDL.Scancode4 -> Hotkey4
+    SDL.Scancode5 -> Hotkey5
+    SDL.Scancode6 -> Hotkey6
+    SDL.Scancode7 -> Hotkey7
+    SDL.Scancode8 -> Hotkey8
+    SDL.Scancode9 -> Hotkey9
+    SDL.Scancode0 -> Hotkey0
+    _ -> undefined
+
+tryAssignHotkey :: World -> SDL.Scancode -> World
+tryAssignHotkey w sc = fromMaybe w $ do
+    pt <- w ^? input . pressedKeys . ix sc
+    guard (pt == InitialPress)
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    itid <- cr ^? crManipulation . manObject . inInventory . ispItem
+    return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
 
 -- | Turn key presses into creature movement.
+-- | note the order of operation, setting the posture first--this prevents the twist fire bug
 wasdWithAiming ::
     World ->
     -- | Base speed
@@ -63,9 +116,11 @@ wasdWithAiming w speed cr
         itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
         let currenttwistamount = cr ^. crTwist
-        case (astance,currenttwistamount) of
+        case (astance, currenttwistamount) of
-            ( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
+            (TwoHandTwist, 0) ->
-                    . (crDir -~ twistamount * pi)
+                return $
+                    (crTwist .~ twistamount * pi)
+                        . (crDir -~ twistamount * pi)
             _ -> Nothing
     theMovement
         | movDir == V2 0 0 = id
@@ -78,8 +133,8 @@ wasdWithAiming w speed cr
     dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
     movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
     isAiming = _posture (_crStance cr) == Aiming
-    mouseDir = fromMaybe 
+    mouseDir = fromMaybe
-        (argV (_mousePos (_input w)) + (w ^. wCam . camRot) )
+        (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
         $ do
             itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
             _ <- cr ^? crInv . ix itRef . itScope . scopePos
@@ -92,7 +147,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
         itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
         cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
 
-
 -- | Set posture according to mouse presses.
 mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
 mouseActionsCr pkeys cr
@@ -114,10 +168,12 @@ pressedMBEffectsTopInventory pkeys w
     | otherwise = w
   where
     inTopInv = case w ^. hud . hudElement of
-        DisplayInventory {_subInventory = NoSubInventory} -> True
+        DisplayInventory{_subInventory = NoSubInventory} -> True
         _ -> False
     isDown but = but `M.member` pkeys
     theinput = w ^. input
-    rotation = maybe 0 
+    rotation =
-        (angleBetween (theinput ^. mousePos)) 
+        maybe
-        (theinput ^. heldPos . at SDL.ButtonMiddle)
+            0
+            (angleBetween (theinput ^. mousePos))
+            (theinput ^. heldPos . at SDL.ButtonMiddle)

src/Dodge/Data/Creature.hs

@@ -32,6 +32,7 @@ import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
 import qualified IntMapHelp as IM
+
 --import MaybeHelp
 
 data Creature = Creature
@@ -55,7 +56,9 @@ data Creature = Creature
     , _crInvLock :: Bool
     , _crInvEquipped :: IM.IntMap EquipPosition
     , _crEquipment :: M.Map EquipPosition Int
-    , _crLeftInvSel :: LeftInvSel
+--    , _crLeftInvSel :: LeftInvSel
+    , _crInvHotkeys :: IM.IntMap Hotkey
+    , _crHotkeys :: M.Map Hotkey Int
     , _crState :: CreatureState
     , _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
     , _crMaterial :: Material

src/Dodge/Data/Equipment/Misc.hs

@@ -27,10 +27,25 @@ data EquipPosition
     | OnSpecial
     deriving (Eq, Ord)
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+data Hotkey = HotkeyQ
+    | HotkeyE
+    | Hotkey1
+    | Hotkey2
+    | Hotkey3
+    | Hotkey4
+    | Hotkey5
+    | Hotkey6
+    | Hotkey7
+    | Hotkey8
+    | Hotkey9
+    | Hotkey0
+  deriving (Eq, Show, Read, Ord, Bounded, Enum) --Generic, Flat)
 
 
 deriveJSON defaultOptions ''EquipSite
 deriveJSON defaultOptions ''EquipPosition
+deriveJSON defaultOptions ''Hotkey
 instance ToJSONKey EquipPosition
-
 instance FromJSONKey EquipPosition
+instance ToJSONKey Hotkey
+instance FromJSONKey Hotkey

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -27,7 +27,6 @@ data Manipulation -- should be ManipulatedObject?
 data ManipulatedObject
     = InInventory {_inInventory :: InventoryManipulation}
     | SelNothing
---    | SelCloseObject {_ispCloseObject :: Int}
     | InNearby {_inNearby :: NearbyManipulation}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -46,17 +45,11 @@ data InvSelAction
     | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data LeftInvSel = LeftInvSel
-    { _lisMPos :: Maybe Int
-    , _lisActive   :: Bool
-    }
-
 makeLenses ''LoadAction
 makeLenses ''ManipulatedObject
 makeLenses ''Manipulation
 makeLenses ''InventoryManipulation
 makeLenses ''NearbyManipulation
-makeLenses ''LeftInvSel
 makeLenses ''InvSelAction
 deriveJSON defaultOptions ''LoadAction
 deriveJSON defaultOptions ''InvSelAction
@@ -64,4 +57,3 @@ deriveJSON defaultOptions ''InventoryManipulation
 deriveJSON defaultOptions ''NearbyManipulation
 deriveJSON defaultOptions ''ManipulatedObject
 deriveJSON defaultOptions ''Manipulation
-deriveJSON defaultOptions ''LeftInvSel

src/Dodge/Data/Item/Use/Equipment.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-
 module Dodge.Data.Item.Use.Equipment (
     module Dodge.Data.Equipment.Misc,
     module Dodge.Data.Item.Use.Equipment,

src/Dodge/Data/Terminal.hs

@@ -46,7 +46,7 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
-    , _tmPartialCommand :: Maybe String
+    , _tmPartialCommand :: Maybe TerminalCommand
     }
     --deriving (Eq, Show, Read) --, Generic)
     --h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -58,7 +58,7 @@ data TmTm
     = TmId
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
-    | TmTmSetPartialCommand (Maybe String)
+    | TmTmSetPartialCommand (Maybe TerminalCommand)
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data TerminalLine
@@ -126,15 +126,17 @@ makeLenses ''TerminalLine
 makeLenses ''TerminalToggle
 makeLenses ''EffectArguments
 makeLenses ''TerminalCommand
-deriveJSON defaultOptions ''TerminalStatus
+concat <$> mapM (deriveJSON defaultOptions)
-deriveJSON defaultOptions ''TerminalInput
+    [ ''TerminalStatus
-deriveJSON defaultOptions ''TerminalLineString
+    , ''TerminalInput
-deriveJSON defaultOptions ''TmTm
+    , ''TerminalLineString
-deriveJSON defaultOptions ''TerminalLine
+    , ''TmTm
-deriveJSON defaultOptions ''TerminalBootProgram
+    , ''TerminalLine
-deriveJSON defaultOptions ''BlBl
+    , ''TerminalBootProgram
-deriveJSON defaultOptions ''TerminalToggle
+    , ''BlBl
-deriveJSON defaultOptions ''EffectArguments
+    , ''TerminalToggle
-deriveJSON defaultOptions ''TerminalCommandEffect
+    , ''EffectArguments
-deriveJSON defaultOptions ''TerminalCommand
+    , ''TerminalCommandEffect
-deriveJSON defaultOptions ''Terminal
+    , ''TerminalCommand
+    , ''Terminal
+    ]

src/Dodge/Default/Creature.hs

@@ -30,13 +30,14 @@ defaultCreature =
         , _crManipulation = Manipulator SelNothing
         , _crInvCapacity = 25
         , _crInvLock = False
-        , _crInvEquipped = mempty
-        , _crLeftInvSel = LeftInvSel Nothing False
         , _crState = defaultState
         , _crCorpse = MakeDefaultCorpse
         , _crMaterial = Flesh
         , _crPastDamage = 0
+        , _crInvEquipped = mempty
         , _crEquipment = M.empty
+        , _crInvHotkeys = mempty
+        , _crHotkeys = M.empty
         , _crStance =
             Stance
                 { _carriage = Walking 0 WasLeftForward

src/Dodge/Default/Terminal.hs

@@ -24,7 +24,7 @@ defaultTerminal =
         , _tmStatus = TerminalOff
         , _tmCommandHistory = []
         , _tmToggles = mempty
-        , _tmPartialCommand = mempty
+        , _tmPartialCommand = Nothing
         }
 
 defaultTerminalInput :: TerminalInput

src/Dodge/DisplayInventory.hs

@@ -20,7 +20,6 @@ import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import Dodge.Inventory.CheckSlots
-import Dodge.Inventory.Color
 import Dodge.Inventory.SelectionList
 import Dodge.SelectionList
 import LensHelp
@@ -130,6 +129,10 @@ updateDisplaySections w cfig sss =
             return $ IM.filter (plainRegex str) itms
         numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
+
+invDimColor :: Color
+invDimColor = greyN 0.7
+
 -- it is annoying that this is necessary
 updateInventorySectionItems :: World -> World
 updateInventorySectionItems w = w 

src/Dodge/Equipment/Text.hs

@@ -0,0 +1,14 @@
+module Dodge.Equipment.Text
+    where
+
+import Dodge.Data.Equipment.Misc
+
+eqPosText :: EquipPosition -> String
+eqPosText ep = case ep of
+    OnHead -> "HEAD"
+    OnChest -> "CHESt"
+    OnBack -> "BACK"
+    OnLeftWrist -> "L.WRIST"
+    OnRightWrist -> "R.WRIST"
+    OnLegs -> "LEGS"
+    OnSpecial -> "EQUIPPED"

src/Dodge/Euse.hs

@@ -1,23 +1,23 @@
 module Dodge.Euse where
 
+import Color
 import Control.Monad
 import Data.Maybe
-import Dodge.LightSource
-import Dodge.Item.HeldOffset
-import Dodge.Wall.Create
-import Color
-import Dodge.Default.Wall
-import Dodge.Creature.Test
 import Dodge.Creature.HandPos
-import Geometry
+import Dodge.Creature.Test
-import Dodge.Wall.Move
-import Dodge.Wall.Delete
-import Dodge.Wall.ForceField
-import Dodge.Item.Location
 import Dodge.Data.World
+import Dodge.Default.Wall
+import Dodge.Item.HeldOffset
+import Dodge.Item.Location
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Radar
+import Dodge.LightSource
 import Dodge.SoundLogic.ExternallyGeneratedSounds
+import Dodge.Wall.Create
+import Dodge.Wall.Delete
+import Dodge.Wall.ForceField
+import Dodge.Wall.Move
+import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 
@@ -32,7 +32,7 @@ useE eo = case eo of
     EonWristShield -> onEquipWristShield
     EoffWristShield -> onRemoveWristShield
     EFuelSource 0 _ -> const . const id
-    EFuelSource {} -> trySiphonFuel
+    EFuelSource{} -> trySiphonFuel
 
 trySiphonFuel :: Item -> Creature -> World -> World
 trySiphonFuel itm cr w = fromMaybe w $ do
@@ -45,14 +45,15 @@ trySiphonFuel itm cr w = fromMaybe w $ do
     amax <- la ^? laMax
     acur <- la ^? laLoaded
     guard (amax > acur)
-    return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ 
+    return $
-            ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
+        w & cWorld . lWorld . creatures . ix (_crID cr) . crInv
-            . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
+            %~ ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
-            )
+                    . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
+               )
 
 isGas :: AmmoType -> Bool
 isGas a = case a of
-    GasAmmo {} -> True
+    GasAmmo{} -> True
     _ -> False
 
 useMagShield :: Item -> Creature -> World -> World
@@ -87,9 +88,7 @@ onRemoveWristShield itm _ =
         return $ deleteWallID i
 
 setWristShieldPos :: Item -> Creature -> World -> World
-setWristShieldPos itm cr w =
+setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
-    w
-        & moveWallIDUnsafe i wlline
   where
     i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
     wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))

src/Dodge/Hotkey.hs

@@ -0,0 +1,46 @@
+module Dodge.Hotkey (
+    assignHotkey,
+    assignNewHotkey,
+    removeHotkey,
+) where
+
+import Control.Lens
+import Data.List
+import qualified Data.Map.Strict as M
+import qualified IntMapHelp as IM
+import Data.Maybe
+import Dodge.Data.World
+import Control.Monad
+
+assignNewHotkey :: Int -> Creature -> Creature
+assignNewHotkey invid cr = assignHotkey invid (newHotkey cr) cr
+
+newHotkey :: Creature -> Hotkey
+newHotkey cr = fromMaybe maxBound $ find (not . (`M.member` usedhks)) [minBound .. maxBound]
+  where
+    usedhks = cr ^?! crHotkeys
+
+-- this will not remove the hotkey from its old slot, assumes there is a hotkey
+-- to swap with instead
+-- requires there actually is equipment in the slot, too
+assignHotkey :: Int -> Hotkey -> Creature -> Creature
+assignHotkey invid hk cr = fromMaybe cr $ do
+    guard (invid `IM.member` (cr ^. crInvEquipped))
+    _ <- cr ^? crInv . ix invid . itUse . leftUse
+    return $ (setHotkey invid hk . moveOldHotkey invid hk) cr
+
+moveOldHotkey :: Int -> Hotkey -> Creature -> Creature
+moveOldHotkey invid hk w = fromMaybe w $ do
+    oldhk <- w ^? crInvHotkeys . ix invid
+    oldid <- w ^? crHotkeys . ix hk
+    return $ w & setHotkey oldid oldhk
+
+setHotkey :: Int -> Hotkey -> Creature -> Creature
+setHotkey i hk = (crInvHotkeys . at i ?~ hk) . (crHotkeys . at hk ?~ i)
+
+removeHotkey :: Int -> Creature -> Creature
+removeHotkey invid cr = cr & crInvHotkeys . at invid .~ Nothing
+    & fromMaybe id (do
+        hk <- cr ^? crInvHotkeys . ix invid
+        return (crHotkeys . at hk .~ Nothing)
+        )

src/Dodge/Inventory.hs

@@ -1,40 +1,29 @@
 --{-# LANGUAGE TupleSections #-}
-
 module Dodge.Inventory (
-    selSecSelPos,
     checkInvSlotsYou,
     rmSelectedInvItem,
-    selNumTextEndPos,
-    selSecSelCol,
-    selNumEndMidHeight,
     rmInvItem,
     updateCloseObjects,
     updateRBList,
-    checkTermDist,
     closeObjScrollDir,
     changeSwapSel,
     scrollAugInvSel,
     crNumFreeSlots,
     crInvSize,
     selectedCloseObject,
-    invDimColor,
     setInvPosFromSS,
 ) where
 
-import Control.Monad
-import Color
 import Control.Applicative
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
-import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.DisplayInventory
 import Dodge.Euse
 import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.CloseObject
-import Dodge.Inventory.Color
 import Dodge.ItEffect
 import Dodge.Reloading
 import Dodge.SelectionSections
@@ -62,13 +51,21 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     _ ->
         w
             & pointcid %~ crCancelReloading
-            & pointcid . crInv %~ f
-            & pointcid . crLeftInvSel . lisMPos %~ g'
-            & removeAnySlotEquipment
-            & dounequipfunction
             & doanyitemeffect
+            & dounequipfunction         --the ordering of these is
+            & pointcid . crInv %~ f     -- important
+--            & pointcid . crLeftInvSel . lisMPos %~ g'
+
+            & removeAnySlotEquipment
+            & pointcid . crEquipment . each %~ g
             & pointcid . crInvEquipped %~ IM.delete invid
             & pointcid . crInvEquipped %~ IM.mapKeys g
+
+            & removeanyactivation
+            & pointcid . crHotkeys . each %~ g
+            & pointcid . crInvHotkeys %~ IM.delete invid
+            & pointcid . crInvHotkeys %~ IM.mapKeys g
+
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
   where
@@ -89,12 +86,12 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     doanyitemeffect = fromMaybe id $ do
         rmf <- itm ^? itEffect . ieOnDrop
         return $ doInvEffect rmf itm cr
-    --removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
-    --    Just epos -> pointcid . crEquipment . at epos .~ Nothing
-    --    Nothing -> id
     removeAnySlotEquipment = fromMaybe id $ do
         epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
         return $ pointcid . crEquipment . at epos .~ Nothing
+    removeanyactivation = fromMaybe id $ do
+        epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid
+        return $ pointcid . crHotkeys . at epos .~ Nothing
     maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split invid inv
@@ -103,74 +100,17 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     g x
         | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
-    g' Nothing = Nothing
+--    g' Nothing = Nothing
-    g' (Just x)
+--    g' (Just x)
-        | x == invid = Nothing
+--        | x == invid = Nothing
-        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
+--        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
-        | otherwise = Just x
+--        | otherwise = Just x
 
 rmSelectedInvItem :: Int -> World -> World
 rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
     Just i -> rmInvItem cid i w
     Nothing -> w
 
---selNumPos :: ManipulatedObject -> World -> Maybe Int
---selNumPos mo w =
---    w ^? hud . hudElement . diSections
---        >>= case mo of
---            InInventory SortInventory -> selSecSelPos (-1) 0
---            InInventory (SelItem i _) -> selSecSelPos 0 i
---            SelNothing -> selSecSelPos 1 0
---            InNearby SortNearby -> selSecSelPos 2 0
---            InNearby (SelCloseObject i) -> selSecSelPos 3 i
-
--- there are still more ListDisplayParams to integrate here
-selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
-selNumTextEndPos cfig ldp sss i j = do
-    ipos <- selSecSelPos i j sss
-    return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
-  where
-    s = _ldpScale ldp
-    ygap = _ldpVerticalGap ldp
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-
-selNumEndMidHeight ::
-    Configuration ->
-    ListDisplayParams ->
-    SelectionSections a ->
-    Int ->
-    Int ->
-    Maybe Point2
-selNumEndMidHeight cfig ldp sss i j = do
-    ipos <- selSecSelPos i j sss
-    size <- selSecSelSize i j sss
-    --let bump = negate $ (10 * s + ygap) * fromIntegral size
-    return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
-  where
-    s = _ldpScale ldp
-    ygap = _ldpVerticalGap ldp
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-
-selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
-selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
-
-checkTermDist :: World -> World
---checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
---    Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do
---        btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
---        btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
---        guard $ dist btpos (_crPos $ you w) < 40
---        return w
---    Nothing -> w
-checkTermDist w = fromMaybe w $ do
-    tmid <- w ^? hud . hudElement . subInventory . termID
-    btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
-    btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
-    guard $ dist btpos (_crPos $ you w) > 40
-    return (w & hud . hudElement . subInventory .~ NoSubInventory)
-
 -- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
@@ -202,7 +142,7 @@ updateCloseObjects w =
 updateRBList :: World -> World
 updateRBList w
     | w ^? rbOptions . opItemID == mcurrentitemid =
-        w & setEquipAllocation & setEquipActivation
+        w & setEquipAllocation
     | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
         i <- cr ^? crManipulation . manObject . inInventory . ispItem
         esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -218,12 +158,10 @@ updateRBList w
                         , _opActivateEquipment = NoChangeActivateEquipment
                         }
                 & setEquipAllocation
-                & setEquipActivation
   where
     mcurrentitemid = do
         i <- cr ^? crManipulation . manObject . inInventory . ispItem
         cr ^? crInv . ix i . itID
-    --curinvid = crSel cr
     cr = you w
 
 chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
@@ -240,83 +178,72 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
 setEquipAllocation :: World -> World
 setEquipAllocation w = fromMaybe w $ do
     curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
-    return $ case _rbOptions w of
+    i <- w ^? rbOptions . opSel
-        EquipOptions{_opEquip = es, _opSel = i} ->
+    es <- w ^? rbOptions . opEquip . ix i
-            case you w ^? crInvEquipped . ix curpos of
+    return $
-                Just epos
+        w & rbOptions . opAllocateEquipment .~ case you w ^? crInvEquipped . ix curpos of
-                    | es !! i == epos ->
+            Just epos
-                        w & rbOptions . opAllocateEquipment
+                | es == epos -> RemoveEquipment{_allocOldPos = epos}
-                            .~ RemoveEquipment
+            Just epos
-                                { _allocOldPos = epos
+                | isJust (you w ^? crEquipment . ix es) ->
-                                }
+                    SwapEquipment
-                Just epos
+                        { _allocOldPos = epos
-                    | isJust (you w ^? crEquipment . ix (es !! i)) ->
+                        , _allocNewPos = es
-                        w & rbOptions . opAllocateEquipment
+                        , _allocSwapID = _crEquipment (you w) M.! es
-                            .~ SwapEquipment
+                        }
-                                { _allocOldPos = epos
+            Just epos ->
-                                , _allocNewPos = es !! i
+                MoveEquipment
-                                , _allocSwapID = _crEquipment (you w) M.! (es !! i)
+                    { _allocOldPos = epos
-                                }
+                    , _allocNewPos = es
-                Just epos ->
+                    }
-                    w & rbOptions . opAllocateEquipment
-                        .~ MoveEquipment
-                            { _allocOldPos = epos
-                            , _allocNewPos = es !! i
-                            }
-                Nothing
-                    | isJust (you w ^? crEquipment . ix (es !! i)) ->
-                        w & rbOptions . opAllocateEquipment
-                            .~ ReplaceEquipment
-                                { _allocNewPos = es !! i
-                                , _allocRemoveID = _crEquipment (you w) M.! (es !! i)
-                                }
-                Nothing ->
-                    w & rbOptions . opAllocateEquipment
-                        .~ PutOnEquipment
-                            { _allocNewPos = es !! i
-                            }
-        _ -> w
-
-setEquipActivation :: World -> World
-setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
-    Just DoNotMoveEquipment -> w
-    Just RemoveEquipment{} ->
-        case you w ^. crLeftInvSel . lisMPos of
-            Just i
-                | Just i == minvsel ->
-                    w & rbOptions . opActivateEquipment
-                        .~ DeactivateEquipment
-                            { _deactivateEquipment = i
-                            }
-            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-    Just rbos ->
-        case you w ^. crLeftInvSel . lisMPos of
-            Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-            Just i
-                | invselcanactivate ->
-                    w & rbOptions . opActivateEquipment
-                        .~ ActivateDeactivateEquipment
-                            { _activateEquipment = fromJust minvsel
-                            , _deactivateEquipment = i
-                            }
-            Just i
-                | Just i == rbos ^? allocRemoveID ->
-                    w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
-            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
             Nothing
-                | invselcanactivate ->
+                | isJust (you w ^? crEquipment . ix es) ->
-                    w & rbOptions . opActivateEquipment
+                    ReplaceEquipment
-                        .~ ActivateEquipment
+                        { _allocNewPos = es
-                            { _activateEquipment = fromJust minvsel
+                        , _allocRemoveID = _crEquipment (you w) M.! es
-                            }
+                        }
-            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+            Nothing -> PutOnEquipment{_allocNewPos = es}
-    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+
-  where
+--setEquipActivation :: World -> World
-    minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
+--setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
-    cr = you w
+--    Just DoNotMoveEquipment -> w
-    invselcanactivate = isJust $ do
+--    Just RemoveEquipment{} ->
-        i <- minvsel
+--        case you w ^. crLeftInvSel . lisMPos of
-        return $ cr ^? crInv . ix i . itUse . leftUse
+--            Just i
+--                | Just i == minvsel ->
+--                    w & rbOptions . opActivateEquipment
+--                        .~ DeactivateEquipment
+--                            { _deactivateEquipment = i
+--                            }
+--            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--    Just rbos ->
+--        case you w ^. crLeftInvSel . lisMPos of
+--            Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            Just i
+--                | invselcanactivate ->
+--                    w & rbOptions . opActivateEquipment
+--                        .~ ActivateDeactivateEquipment
+--                            { _activateEquipment = fromJust minvsel
+--                            , _deactivateEquipment = i
+--                            }
+--            Just i
+--                | Just i == rbos ^? allocRemoveID ->
+--                    w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
+--            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            Nothing
+--                | invselcanactivate ->
+--                    w & rbOptions . opActivateEquipment
+--                        .~ ActivateEquipment
+--                            { _activateEquipment = fromJust minvsel
+--                            }
+--            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--  where
+--    minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
+--    cr = you w
+--    invselcanactivate = isJust $ do
+--        i <- minvsel
+--        return $ cr ^? crInv . ix i . itUse . leftUse
 
 equipSiteToPositions :: EquipSite -> [EquipPosition]
 equipSiteToPositions es = case es of
@@ -334,26 +261,33 @@ closeObjScrollDir x
 
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
-    | yi == 0   = w
+    | yi == 0 = w
-    | yi > 0    = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
+    | yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
     | otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
   where
     f g i m = fst <$> g i m
 
-changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
+changeSwapClose ::
-    -> Int -> World -> World
+    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
+    Int ->
+    World ->
+    World
 changeSwapClose f i w = fromMaybe w $ do
     ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
     k <- f i ss
-    return $ w
+    return $
+        w
             & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
                 .~ k
             & hud . closeObjects %~ swapIndices i k
             & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
             & worldEventFlags . at InventoryChange ?~ ()
 
-changeSwapInv :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
+changeSwapInv ::
-    -> Int -> World -> World
+    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
+    Int ->
+    World ->
+    World
 changeSwapInv f i w = fromMaybe w $ do
     ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
     k <- f i ss
@@ -362,60 +296,34 @@ changeSwapInv f i w = fromMaybe w $ do
             & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
             & worldEventFlags . at InventoryChange ?~ ()
   where
-    updateLeftInvSel k li
+--    updateLeftInvSel k li
-        | i == li = k
+--        | i == li = k
-        | k == li = i
+--        | k == li = i
-        | otherwise = li
+--        | otherwise = li
     updatecreature k =
         (crInv %~ IM.safeSwapKeys i k)
-            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
+--            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
             . (crManipulation . manObject . inInventory . ispItem .~ k)
             . (crInvEquipped %~ IM.safeSwapKeys i k)
             . swapSite i k
             . swapSite k i
+            . (crInvHotkeys %~ IM.safeSwapKeys i k)
+            . swapSite' i k
+            . swapSite' k i
     cr = you w
     swapSite a b = case cr ^? crInvEquipped . ix a of
         Just epos -> crEquipment . ix epos .~ b
         Nothing -> id
+    swapSite' a b = case cr ^? crInvHotkeys . ix a of
+        Just epos -> crHotkeys . ix epos .~ b
+        Nothing -> id
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
-    Just (0,i) -> w & changeSwapInv f i
+    Just (0, i) -> w & changeSwapInv f i
-    Just (3,i) -> w & changeSwapClose f i
+    Just (3, i) -> w & changeSwapClose f i
     _ -> w
 
---changeSwapInvSel' :: Int -> World -> World
---changeSwapInvSel' k w = case you w ^? crManipulation . manObject of
---    Just (InInventory (SelItem i _)) ->
---        w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
---            & worldEventFlags . at InventoryChange ?~ ()
---    Just (InNearby (SelCloseObject i)) ->
---        w
---            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
---                .~ ((i - k) `mod` numCO)
---            & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
---            & worldEventFlags . at InventoryChange ?~ ()
---    _ -> w
---  where
---    updatecreature i =
---        (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
---            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
---            . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k)
---            . (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
---            . swapSite i (swapi i)
---            . swapSite (swapi i) i
---    swapSite a b = case cr ^? crInvEquipped . ix a of
---        Just epos -> crEquipment . ix epos .~ b
---        Nothing -> id
---    cr = you w
---    swapi i = (i - k) `mod` n
---    updateLeftInvSel i li
---        | i == li = swapi i
---        | swapi i == li = i
---        | otherwise = li
---    n = length $ _crInv cr
---    numCO = length $ w ^. hud . closeObjects
-
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
     | yi == 0 = w

src/Dodge/Inventory/CheckSlots.hs

@@ -8,7 +8,7 @@ import Control.Lens
 import Data.Maybe
 import Dodge.Base.You
 import Dodge.Data.World
-import Dodge.Inventory.ItemSpace
+import Dodge.Item.SlotsTaken
 import qualified IntMapHelp as IM
 
 {- | checks whether or not an item will fit in your inventory

src/Dodge/Inventory/Color.hs

@@ -1,6 +0,0 @@
-module Dodge.Inventory.Color where
-import Color
-
-invDimColor :: Color
-invDimColor = greyN 0.7
-

src/Dodge/Inventory/SelectionList.hs

@@ -1,47 +1,66 @@
-module Dodge.Inventory.SelectionList 
+module Dodge.Inventory.SelectionList (
-    ( invSelectionItem
+    invSelectionItem,
-    , closeObjectToSelectionItem
+    closeObjectToSelectionItem,
-    )
+) where
-    where
 
-import Dodge.Item.Display
+import Dodge.Equipment.Text
-import Dodge.Inventory.ItemSpace
-import Picture.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
+import Dodge.Item.SlotsTaken
+import Dodge.Item.Display
 import LensHelp
+import Picture.Base
 
-invSelectionItem :: Creature ->  Int -> Item -> SelectionItem ()
+invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
-invSelectionItem cr i it = SelectionItem
+invSelectionItem cr i it =
-    { _siPictures = pics
+    SelectionItem
-    , _siHeight = length pics
+        { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-    , _siIsSelectable = True
+        , _siHeight = length pics
-    --, _siWidth = 15
+        , _siIsSelectable = True
-    , _siColor = col
+        , _siColor = col
-    , _siOffX = 0
+        , _siOffX = 0
-    , _siPayload = ()
+        , _siPayload = ()
-    }
+        }
   where
+    anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
+    anyequippos = maybe [] ((' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
     col = _itInvColor it
     pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
         UndroppableIdentified -> itemDisplay it
         _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
         _ -> itemDisplay it
 
+hotkeyToString :: Hotkey -> String
+hotkeyToString x = case x of
+    HotkeyQ -> "[Q]"
+    HotkeyE -> "[E]"
+    Hotkey1 -> "[1]"
+    Hotkey2 -> "[2]"
+    Hotkey3 -> "[3]"
+    Hotkey4 -> "[4]"
+    Hotkey5 -> "[5]"
+    Hotkey6 -> "[6]"
+    Hotkey7 -> "[7]"
+    Hotkey8 -> "[8]"
+    Hotkey9 -> "[9]"
+    Hotkey0 -> "[0]"
+
 closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
-closeObjectToSelectionItem e = SelectionItem
+closeObjectToSelectionItem e =
-    { _siPictures = pics
+    SelectionItem
-    , _siHeight = length pics
+        { _siPictures = pics
-    , _siIsSelectable = True
+        , _siHeight = length pics
-    --, _siWidth = 15
+        , _siIsSelectable = True
-    , _siColor = col
+        , --, _siWidth = 15
-    , _siOffX = 2
+          _siColor = col
-    , _siPayload = ()
+        , _siOffX = 2
-    }
+        , _siPayload = ()
+        }
   where
-    (pics,col) = closeObjectToTextPictures e
+    (pics, col) = closeObjectToTextPictures e
+
 --
-closeObjectToTextPictures :: Either FloorItem Button -> ([String],Color)
+closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
 closeObjectToTextPictures e = case e of
-    Left flit -> let it = _flIt flit in ( itemDisplay it, _itInvColor it)
+    Left flit -> let it = _flIt flit in (itemDisplay it, _itInvColor it)
     Right bt -> ([_btText bt], yellow)

src/Dodge/ItEffect.hs

@@ -1,5 +1,6 @@
 module Dodge.ItEffect where
 
+import qualified IntMapHelp as IM
 import Control.Lens
 import Dodge.Data.World
 import Dodge.Euse
@@ -49,7 +50,7 @@ chargeIfInInventory itm cr w =
 
 chargeIfEquipped :: Item -> Creature -> World -> World
 chargeIfEquipped itm cr
-    | Just invid == cr ^. crLeftInvSel . lisMPos =
+    | invid `IM.member` (cr ^. crInvHotkeys)  =
         ptrWpCharge %~ (min maxcharge . (+ 1))
     | otherwise = ptrWpCharge .~ 0
   where

src/Dodge/Item/Display.hs

@@ -7,7 +7,7 @@ module Dodge.Item.Display (
 import Data.Maybe
 import Data.Sequence
 import Dodge.Data.Creature
-import Dodge.Inventory.ItemSpace
+import Dodge.Item.SlotsTaken
 import Dodge.Module
 import LensHelp
 import Padding

src/Dodge/Item/SlotsTaken.hs

@@ -1,4 +1,4 @@
-module Dodge.Inventory.ItemSpace (
+module Dodge.Item.SlotsTaken (
     itSlotsTaken,
 ) where
 

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -4,15 +4,11 @@
 Extra weapon effects, supplementing explicit use effects.
 -}
 module Dodge.Item.Weapon.ExtraEffect (
-    -- itemLaserScopeEffect
     autoSonarEffect,
     autoEffect,
     autoRadarEffect,
-    --    , rbSetTarget
 ) where
 
---import Dodge.Item.Attachment.Data
-
 import Dodge.Data.World
 import Dodge.RadarSweep
 import Dodge.SoundLogic

src/Dodge/Menu/Option.hs

@@ -83,7 +83,8 @@ optionsToSelections maxlines u allops pmo = case pmo of
         | maxlines >= length allops = allops
         | otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption]
     maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
-    cycleOptionsOption = Toggle cycleOptions (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m)))
+    cycleOptionsOption = Toggle cycleOptions 
+        (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m)))
     l = length allops
     m = div (l - 1) (max 1 (maxlines - 2)) + 1
     n = div (offset + 1) (max 1 (maxlines - 2)) + 1
@@ -108,8 +109,7 @@ colStrToSelItem (col, str) =
         { _siPictures = [str]
         , _siHeight = 1
         , _siIsSelectable = True
-        , --, _siWidth = length str
+        , _siColor = col
-          _siColor = col
         , _siOffX = 0
         , _siPayload = id
         }
@@ -129,8 +129,7 @@ menuOptionToSelectionItem w padAmount mo =
         { _siPictures = [optionText]
         , _siHeight = 1
         , _siIsSelectable = isselectable
-        , --, _siWidth = length optionText
+        , _siColor = thecol
-          _siColor = thecol
         , _siOffX = 0
         , _siPayload = (f, g)
         }

src/Dodge/Render/HUD.hs

@@ -4,7 +4,7 @@ module Dodge.Render.HUD (
 ) where
 
 import Control.Lens
-import Data.Foldable
+import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
@@ -17,11 +17,13 @@ import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Default.SelectionList
+import Dodge.Equipment.Text
 import Dodge.Inventory
 import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 import Dodge.Render.List
+import Dodge.SelectionSections
 import Dodge.SelectionSections.Draw
 import Dodge.Tweak.Show
 import Geometry
@@ -49,7 +51,7 @@ drawInventory sss = drawSelectionSections sss . invDisplayParams
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-    NoSubInventory -> drawNoSubInventory cfig w
+    NoSubInventory -> drawRBOptions cfig w
     ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
@@ -108,30 +110,36 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
     Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
     _ -> x
 
-drawNoSubInventory :: Configuration -> World -> Picture
+drawRBOptions :: Configuration -> World -> Picture
-drawNoSubInventory cfig w =
+drawRBOptions cfig w = fromMaybe mempty $ do
-    fold
+    guard $ ButtonRight `M.member` _mouseButtons (_input w)
-        [ equipcursors
+    es <- w ^? rbOptions . opEquip
-        , equipcursor -- the order is important, this should go on top of the other equipcursors
+    i <- w ^? rbOptions . opSel
-        , rboptions
+    ae <- w ^? rbOptions . opAllocateEquipment
-        ]
+    sss <- w ^? hud . hudElement . diSections
+    (i', j) <- sss ^? sssExtra . sssSelPos . _Just
+    curpos <- selSecSelPos i' j sss
+    let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
+    let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
+    return $
+        listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
+            <> case ae of
+                DoNotMoveEquipment -> mempty
+                PutOnEquipment{} ->
+                    midtext "PUT ONTO"
+                MoveEquipment{} ->
+                    midtext "MOVE  TO" <> extratext []
+                SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
+                    midtext "MOVE  TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
+                ReplaceEquipment{_allocRemoveID = rid} ->
+                    midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
+                RemoveEquipment{} ->
+                    midtext "TAKE OFF"
   where
-    equipcursor = fromMaybe mempty $ do
+    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
-        invid <- cr ^. crLeftInvSel . lisMPos
+        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
-        sss <- w ^? hud . hudElement . diSections
+        Nothing -> ""
-        pos <- selSecSelPos 0 invid sss
+    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
-        return $
-            listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $
-                _crInvEquipped cr IM.! invid
-    f col invid epos = fromMaybe mempty $ do
-        sss <- w ^? hud . hudElement . diSections
-        pos <- selSecSelPos 0 invid sss
-        return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
-    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
-    cr = you w
-    rboptions
-        | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
-        | otherwise = mempty
 
 examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
 examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
@@ -147,7 +155,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     cpos <- selSecSelPos i j sss
     let col = _siColor si
     return $
-        pictures
+        mconcat
             [ fromMaybe mempty $ do
                 strs <- si ^? siPayload . ciInfo
                 return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
@@ -163,42 +171,6 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
         return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i
 
---    fromMaybe mempty $ do
---    i <- mi
---    let cpos = getIthPos i (sm ^. smShownItems)
---    col <- sm ^? smShownItems . ix i . siColor
---    return $
---        pictures
---            [ fromMaybe mempty $ do
---                strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
---                return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
---            , fromMaybe mempty $ do
---                lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
---                return $
---                    lnkMidPosInvSelsCol cfig w cpos col lnks
---                        -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
---                        <> foldMap invcursor lnks
---                        <> combineCounts cfig w lnks
---            ]
---  where
---    invcursor i = fromMaybe mempty $ do
---        sss <- w ^? hud . hudElement . diSections
---        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
-
---thirdColumnPara :: [String] -> SelectionList ()
---thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
---  where
---    f str =
---        SelectionItem
---            { _siPictures = [text str]
---            , _siHeight = 1
---            , _siIsSelectable = True
---            , _siWidth = length str
---            , _siColor = white
---            , _siOffX = 0
---            , _siPayload = ()
---            }
-
 displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
     tm <- w ^? terminals . ix tid
@@ -214,8 +186,9 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
             . take (_tmMaxLines tm)
             $ _tmDisplayedLines tm
     displayTermInput tm = case _tmInput tm of
-        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
+        TerminalInput{_tiText = s, _tiFocus = hasfoc} ->
-    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just
+            (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
+    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
     displayInputText tm s
         | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
         | otherwise = ""
@@ -223,45 +196,6 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
         | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
         | otherwise = []
 
-drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
-drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
-    fromMaybe mempty $ do
-        sss <- w ^? hud . hudElement . diSections
-        (i', j) <- sss ^? sssExtra . sssSelPos . _Just
-        curpos <- selSecSelPos i' j sss
-        let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
-        let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
-        return $
-            listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
-                <> case ae of
-                    DoNotMoveEquipment -> mempty
-                    PutOnEquipment{} ->
-                        midtext "PUT ONTO"
-                    MoveEquipment{} ->
-                        midtext "MOVE  TO" <> extratext []
-                    SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
-                        midtext "MOVE  TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
-                    ReplaceEquipment{_allocRemoveID = rid} ->
-                        midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
-                    RemoveEquipment{} ->
-                        midtext "TAKE OFF"
-  where
-    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
-        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
-        Nothing -> ""
-    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
-drawRBOptions _ _ _ = mempty
-
-eqPosText :: EquipPosition -> String
-eqPosText ep = case ep of
-    OnHead -> "HEAD"
-    OnChest -> "CHEST"
-    OnBack -> "BACK"
-    OnLeftWrist -> "L.WRIST"
-    OnRightWrist -> "R.WRIST"
-    OnLegs -> "LEGS"
-    OnSpecial -> "EQUIPPED"
-
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = foldMap f . group
   where
@@ -431,3 +365,35 @@ displayHP cid cfig =
         . leftPad 5 ' '
         . show
         . (^?! cWorld . lWorld . creatures . ix cid . crHP)
+
+-- there are still more ListDisplayParams to integrate here
+selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
+selNumTextEndPos cfig ldp sss i j = do
+    ipos <- selSecSelPos i j sss
+    return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
+  where
+    s = _ldpScale ldp
+    ygap = _ldpVerticalGap ldp
+    hh = halfHeight cfig
+    hw = halfWidth cfig
+
+selNumEndMidHeight ::
+    Configuration ->
+    ListDisplayParams ->
+    SelectionSections a ->
+    Int ->
+    Int ->
+    Maybe Point2
+selNumEndMidHeight cfig ldp sss i j = do
+    ipos <- selSecSelPos i j sss
+    size <- selSecSelSize i j sss
+    --let bump = negate $ (10 * s + ygap) * fromIntegral size
+    return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
+  where
+    s = _ldpScale ldp
+    ygap = _ldpVerticalGap ldp
+    hh = halfHeight cfig
+    hw = halfWidth cfig
+
+selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
+selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor

src/Dodge/Render/List.hs

@@ -4,12 +4,12 @@ module Dodge.Render.List where
 
 --import Data.Foldable
 
+import Dodge.SelectionSections
 import Data.Maybe
 import Dodge.Base.Window
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
-import Dodge.Inventory
 import Dodge.SelectionList
 import Geometry
 import LensHelp
@@ -119,13 +119,14 @@ listCursorChooseBorderScale ::
     Picture
 listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
     translate
-        (15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
+        --(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
-        (halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
+        (xoff - halfWidth cfig)
+        (halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
   where
     x = 9
-    wth = x * fromIntegral cursxsize + 9
+    wth = x * fromIntegral cursxsize + 10
     hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
 
 -- displays a cursor that should match up to list text pictures
@@ -137,15 +138,12 @@ listCursorChooseBorder = listCursorChooseBorderScale 10 1
 
 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
-chooseCursorBorders wth hgt = foldMap (line . toLine)
+chooseCursorBorders w h = foldMap (line . toLine)
   where
-    top = 0
+    toLine North = [V2 0 h, V2 w h]
-    bot = - hgt
+    toLine East = [V2 w h, V2 w 0]
-    lef = 0
+    toLine South = [V2 w 0, V2 0 0]
-    toLine North = [V2 lef top, V2 wth top]
+    toLine West = [V2 0 0, V2 0 h]
-    toLine East = [V2 wth top, V2 wth bot]
-    toLine South = [V2 wth bot, V2 lef bot]
-    toLine West = [V2 lef bot, V2 lef top]
 
 listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNS = listCursorChooseBorder [North, South]

src/Dodge/Terminal.hs

@@ -256,9 +256,13 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
     case doTerminalCommandEffect (_tcEffect command) tm w of
         NoArguments tls -> Just tls
         OneArgument argtype m ->
-            let setpartial =
+            let setpartial 
-                    TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) :
+                    | null (_tmPartialCommand tm) 
-                    makeTermPara ("expects " ++ argtype ++ " as an argument")
+                        = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just command)) :
+                            makeTermPara ("Expects " ++ argtype ++ " as an argument")
+                    | otherwise = 
+                        TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) :
+                            makeTermPara "No argument input, cancelling"
              in Just $
                     fromMaybe setpartial $
                         safeHead args >>= (m M.!?)

src/Dodge/Terminal/LeftButton.hs

@@ -13,7 +13,7 @@ doTerminalEffectLB :: Terminal -> World -> World
 doTerminalEffectLB tm w = fromMaybe w $ do
     guard (_tmStatus tm == TerminalReady)
     s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
-    if null (words s)
+    if null (words s) && null (_tmPartialCommand tm)
         then Just $ defocusTerminalInput w
         else return $ terminalReturnEffect tm w
 

src/Dodge/Terminal/ReturnEffect.hs

@@ -11,7 +11,7 @@ terminalReturnEffect :: Terminal -> World -> World
 terminalReturnEffect tm w = fromMaybe w $ do
     guard $ _tmStatus tm == TerminalReady
     s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
-    let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just
+    let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
     return $
         runTerminalString (pc ++ s) tm $
             w
@@ -22,7 +22,7 @@ terminalReturnEffect tm w = fromMaybe w $ do
 runTerminalString :: String -> Terminal -> World -> World
 runTerminalString s tm w =
     w & cWorld . lWorld . terminals . ix (_tmID tm)
-        %~ ( (tmInput .~ TerminalInput mempty True (0, 0))
+        %~ ( (tmInput .~ TerminalInput {_tiText = mempty, _tiFocus = True, _tiSel = (0, 0)})
                 . (tmFutureLines ++.~ commandFutureLines s tm w)
                 . (tmCommandHistory %~ take 10 . (s :))
            )

src/Dodge/TestString.hs

@@ -18,10 +18,14 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
+testStringInit u =  getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
-    , show $ getSmoothScrollValue (u ^. uvWorld . input)
+    <> ["---"]
-    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
+    <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
-    ]
+    
+--    [show $ u ^. uvWorld . input . smoothScrollAmount
+--    , show $ getSmoothScrollValue (u ^. uvWorld . input)
+--    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
+--    ]
 --    [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) 
 --        (u ^. uvWorld . cWorld . lWorld)
 --        , show a

src/Dodge/Update.hs

@@ -6,8 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
---import Dodge.InputFocus
+import Control.Monad
-
 import Dodge.Update.Input.InGame
 import Dodge.Update.Input.ScreenLayer
 import Dodge.Debug
@@ -279,6 +278,15 @@ functionalUpdate w =
         -- . over uvWorld updateInventorySelectionList
         $ over uvWorld updatePastWorlds w
 
+checkTermDist :: World -> World
+checkTermDist w = fromMaybe w $ do
+    tmid <- w ^? hud . hudElement . subInventory . termID
+    btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
+    btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
+    guard $ dist btpos (_crPos $ you w) > 40
+    return (w & hud . hudElement . subInventory .~ NoSubInventory)
+
+
 updateWheelEvents :: World -> World
 updateWheelEvents w
     | yi == 0 = w
@@ -293,8 +301,8 @@ advanceScrollAmount u =
         & uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
 
 updatePastWorlds :: World -> World
---updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
+updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
-updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 600 . ((w ^. cWorld . lWorld) :))
+--updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 600 . ((w ^. cWorld . lWorld) :))
 
 doWorldEvents :: World -> World
 doWorldEvents w =

src/Dodge/Update/Scroll.hs

@@ -2,7 +2,6 @@ module Dodge.Update.Scroll (
     updateWheelEvent,
 ) where
 
-import Dodge.SelectionSections
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
@@ -10,6 +9,7 @@ import Dodge.Data.Universe
 import Dodge.HeldScroll
 import Dodge.InputFocus
 import Dodge.Inventory
+import Dodge.SelectionSections
 import Dodge.SoundLogic
 import Dodge.Terminal
 import Dodge.Tweak
@@ -22,7 +22,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     DisplayCarte
         | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
         | otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
-    DisplayInventory {_subInventory = NoSubInventory}
+    DisplayInventory{_subInventory = NoSubInventory}
         -- functions that modify the inventory should be centralised so that
         -- this lock can be sensibly applied, perhaps
         | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
@@ -33,13 +33,13 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         | lbDown -> w & wCam . camZoom +~ y
         | invKeyDown -> changeSwapSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
-    DisplayInventory {_subInventory = ExamineInventory mi}
+    DisplayInventory{_subInventory = ExamineInventory mi}
         | invKeyDown && rbDown -> w & moveTweakSel yi
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
         | rbDown -> w & changeTweakParam mi yi
         | otherwise -> w & moveTweakSel yi
-    DisplayInventory {_subInventory = CombineInventory {}} -> w & moveCombineSel yi
+    DisplayInventory{_subInventory = CombineInventory{}} -> w & moveCombineSel yi
-    DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
+    DisplayInventory{_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
     _ -> w
   where
     y = fromIntegral yi
@@ -49,9 +49,11 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
 moveCombineSel :: Int -> World -> World
-moveCombineSel yi = (hud . hudElement . subInventory . ciSections
+moveCombineSel yi =
-    %~ scrollSelectionSections yi)
+    ( hud . hudElement . subInventory . ciSections
-    .  (worldEventFlags . at CombineInventoryChange ?~ ())
+        %~ scrollSelectionSections yi
+    )
+        . (worldEventFlags . at CombineInventoryChange ?~ ())
 
 moveSubSel :: Int -> Int -> World -> World
 moveSubSel yi maxyi =
@@ -70,28 +72,30 @@ terminalWheelEvent yi tmid w
             w
                 & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
     | inTermFocus w =
-        w
+        guardDisconnectedID tmid w $
-            & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
+            w
+                & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
     | otherwise = w
   where
     rbDown = ButtonRight `M.member` _mouseButtons (_input w)
     updatetermsel tm = case tm ^? tmInput . tiSel of
         Nothing -> tm & tmInput . tiSel .~ (0, 0)
         Just (i, _) ->
-            let newi = (i - yi) `mod` length (scrollCommands tm)
+            let newi = (i - yi) `mod` length (scrollCommandStrings w tm)
-             in tm & setInput newi 0 w
+             in tm & setInput newi 0
     updatetermsubsel tm = case tm ^? tmInput . tiSel of
         Nothing -> tm & tmInput . tiSel .~ (0, 0)
         Just (i, j) ->
             let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
-             in tm & setInput i newj w
+             in tm & setInput i newj
-    setInput i j w' tm =
+    setInput i j tm =
         tm
             & tmInput . tiSel .~ (i, j)
-            & tmInput . tiText .~ (_tcString tc ++ " " ++ arg)
+            & tmInput . tiText .~ (comstr ++ arg)
       where
+        comstr = scrollCommandStrings w tm !! i
         tc = scrollCommands tm !! i
-        arg = getArguments' tc tm w' !! j
+        arg = getArguments' tc tm w !! j
 
 scrollRBOption :: Int -> RightButtonOptions -> RightButtonOptions
 scrollRBOption y w
@@ -119,6 +123,11 @@ changeTweakParam mi i w = fromMaybe w $ do
 scrollCommands :: Terminal -> [TerminalCommand]
 scrollCommands = (nullCommand :) . _tmScrollCommands
 
+scrollCommandStrings :: World -> Terminal -> [String]
+scrollCommandStrings w tm = case tm ^? tmPartialCommand . _Just of
+    Nothing -> map _tcString $ scrollCommands tm
+    Just tc -> "" : map tail (getArguments tc tm w)
+
 getArguments' :: TerminalCommand -> Terminal -> World -> [String]
 getArguments' tc tm = ("" :) . getArguments tc tm
 
@@ -134,4 +143,4 @@ nullCommand =
 getArguments :: TerminalCommand -> Terminal -> World -> [String]
 getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
     NoArguments{} -> []
-    OneArgument _ m -> M.keys m
+    OneArgument _ m -> map (' ' :) $ M.keys m

src/Picture/Base.hs

@@ -201,9 +201,12 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
 
 text :: String -> Picture
 {-# INLINE text #-}
-text = translate (-50) (-100) . drawText (-10)
+--text = translate (-50) (-100) . drawText (-10)
+text = drawText 0
+--text = drawText (-10)
 
 drawText :: Float -> String -> [Verx]
+{-# INLINE drawText #-}
 drawText gap = map f . stringToList gap
   where
     f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum