Work on mouse selection in menus

src/Dodge/Render/List.hs

@@ -1,28 +1,29 @@
 module Dodge.Render.List where
 
-import ListHelp
-import Dodge.Data.SelectionList
 import Data.Foldable
 import Data.Maybe
-import Dodge.Base.WinScale
-import Dodge.Base.Window
-import Dodge.Data.Config
-import Dodge.Data.CardinalPoint
-import Geometry
-import Picture
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Dodge.Base.WinScale
+import Dodge.Base.Window
+import Dodge.Data.CardinalPoint
+import Dodge.Data.Config
+import Dodge.Data.SelectionList
+import Geometry
+import ListHelp
+import Picture
 
 drawSelectionList :: Configuration -> SelectionList -> Picture
-drawSelectionList cfig sl = listPicturesAtScaleOff 
-    (_slVerticalGap sl) 
-    (_slScale sl)
-    (_slPosX sl)
-    (_slPosY sl)
-    cfig
-    (_slOffset sl)
-    (concatMap _siPictures (_slItems sl))
-    <> drawSelectionCursor cfig sl
+drawSelectionList cfig sl =
+    listPicturesAtScaleOff
+        (_slVerticalGap sl)
+        (_slScale sl)
+        (_slPosX sl)
+        (_slPosY sl)
+        cfig
+        (_slOffset sl)
+        (concatMap _siPictures (_slItems sl))
+        <> drawSelectionCursor cfig sl
 
 drawSelectionCursor :: Configuration -> SelectionList -> Picture
 drawSelectionCursor cfig sl = fromMaybe mempty $ do
@@ -55,19 +56,28 @@ stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
 stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
 
 stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
-stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i-1 ..]
+stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..]
 
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)
 -- this is probably because it is 8 pixels plus one for the border
 listCursorChooseBorderScale ::
     Float ->
-    Float -> Set CardinalPoint -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+    Float ->
+    Set CardinalPoint ->
+    Float ->
+    Float ->
+    Configuration ->
+    Int ->
+    Color ->
+    Int ->
+    Int ->
+    Picture
 listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cursysize =
     winScale cfig
         . translate
-            (6 + xoff - halfWidth cfig)
-            (halfHeight cfig + 12.5 - (20 * fromIntegral yint + yoff + 20 + hgt + ygap))
+            (15 - (9 * s) + xoff - halfWidth cfig)
+            (halfHeight cfig + negate (yoff - s * 12.5) - ((s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
   where
@@ -96,22 +106,25 @@ listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize =
 chooseCursorBorders :: Float -> Float -> Set CardinalPoint -> Picture
 chooseCursorBorders wth hgt = fold . Set.map (line . toLine)
   where
-    toLine North = [V2 0 hgt, V2 wth hgt]
-    toLine East = [V2 wth hgt, V2 wth 0]
-    toLine South = [V2 wth 0, V2 0 0]
-    toLine West = [V2 0 0, V2 0 hgt]
+    top = 0
+    bot = - hgt
+    lef = 0
+    toLine North = [V2 lef top, V2 wth top]
+    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 -> Color -> Int -> Int -> Picture
-listCursorNS = listCursorChooseBorder (Set.fromList [North,South])
+listCursorNS = listCursorChooseBorder (Set.fromList [North, South])
 
 listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNES = listCursorChooseBorder (Set.fromList [North,South,East])
+listCursorNES = listCursorChooseBorder (Set.fromList [North, South, East])
 
 listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNESW = listCursorChooseBorder (Set.fromList [North,South,East,West])
+listCursorNESW = listCursorChooseBorder (Set.fromList [North, South, East, West])
 
 listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
-listCursorNSW = listCursorChooseBorder (Set.fromList [North,South,West])
+listCursorNSW = listCursorChooseBorder (Set.fromList [North, South, West])
 
 fillScreenText :: Configuration -> String -> Picture
 fillScreenText cfig str =

src/Dodge/Render/MenuScreen.hs

@@ -4,6 +4,7 @@ module Dodge.Render.MenuScreen (
     menuScreen',
 ) where
 
+import Dodge.Menu.Option
 import Dodge.Data.CardinalPoint
 import Dodge.Render.List
 import Dodge.Data.SelectionList
@@ -75,8 +76,8 @@ drawOptions ::
     Picture
 drawOptions u title ops off mselpos footer =
     pictures $
-        [ darkenBackground cfig
-        , drawTitle cfig title
+        [ --darkenBackground cfig
+         drawTitle cfig title
         , drawFooterText cfig red footer
         , drawSelectionList cfig (makeOptionsSelectionList mselpos u ops)
         ]
@@ -112,18 +113,6 @@ defaultSelectionItem =  SelectionItem
     , _siOffX = 0
     }
 
-makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
-makeOptionsSelectionList mselpos u mos = SelectionList
-    { _slPosX = 50
-    , _slPosY = 50
-    , _slOffset = 0
-    , _slScale = 2
-    , _slVerticalGap = 30
-    , _slItems = optionsToSelections u mos
-    , _slSelPos = mselpos
-    , _slCursorType = BorderCursor (Set.fromList [North,South,West])
-    , _slWidth = FixedSelectionWidth 15
-    }
 colStrToSelItem :: (Color,String) -> SelectionItem
 colStrToSelItem (col,str) = SelectionItem
     { _siPictures = [color col $ text str]
@@ -133,19 +122,6 @@ colStrToSelItem (col,str) = SelectionItem
     , _siOffX = 0
     }
 
-optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
-optionsToSelections u ops = map colStrToSelItem colstrs
-  where
-    maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops)
-    colstrs = map (menuOptionToString u maxOptionLength) visibleops
-    visibleops = filter notInvisible ops
-    notInvisible InvisibleToggle{} = False
-    notInvisible _ = True
-
-optionValueOffset :: Universe -> MenuOption -> Int
-optionValueOffset u mo = case _moString mo u of
-    MODStringOption s _ -> length s
-    _ -> 0
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
@@ -184,17 +160,3 @@ drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
-menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
-  where
-    thecol = case _moString mo w of
-        MODBlockedString{} -> greyN 0.5
-        _ -> white
-    optionText = case _moString mo w of
-        MODStringOption s t -> rightPad padAmount '.' s ++ t
-        x -> _modString x
-    theKeys = case mo of
-        Toggle{_moKey = k} -> stc k : ":"
-        Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
-        _ -> undefined
-    stc = scodeToChar

src/Dodge/Render/Picture.hs

@@ -14,16 +14,11 @@ import Picture
 
 fixedCoordPictures :: Universe -> Picture
 fixedCoordPictures u =
-    drawConcurrentMessage u <> case u ^. uvScreenLayers of
-        [] ->
-            pictures
-                [ hudDrawings u
-                , customMouseCursor cfig w
-                ]
+    drawConcurrentMessage u <> customMouseCursor cfig (u ^. uvWorld) <> case u ^. uvScreenLayers of
+        [] -> hudDrawings u
         (lay : _) -> (setDepth (-1) $ menuScreen' u lay) 
             <> (setDepth (-1) . winScale cfig $ menuScreen u lay)
   where
-    w = _uvWorld u
     cfig = _uvConfig u
 
 drawConcurrentMessage :: Universe -> Picture
@@ -38,18 +33,6 @@ drawConcurrentMessage u =
     f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
     f x = _ceString x ++ " QUEUED"
 
---    = case u ^? uvSideEffects . _head of
---    --Just (BlockingConcEffect str) -> fillWidthText cfig str
---    Just (RunningSideEffect str) ->
---        stackPicturesAt
---            (halfWidth cfig)
---            (_windowY cfig - 50)
---            cfig
---            [centerText str]
---    _ -> mempty
---  where
---    cfig = _uvConfig u
-
 customMouseCursor :: Configuration -> World -> Picture
 customMouseCursor cfig w =
     winScale cfig

src/Dodge/Render/ShapePicture.hs

@@ -40,12 +40,9 @@ import ShapePicture
 import ShortShow
 import Sound.Data
 
-singleSPic :: SPic -> SPic
-singleSPic = id
-
 worldSPic :: Configuration -> World -> SPic
 worldSPic cfig w =
-    singleSPic (mempty, extraPics cfig w)
+    (mempty, extraPics cfig w)
         <> foldup drawProp' (filtOn _prPos _props)
         <> foldup drawProjectile (filtOn _prjPos _projectiles)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
@@ -55,7 +52,7 @@ worldSPic cfig w =
         <> foldup floorItemSPic (filtOn _flItPos _floorItems)
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup mcSPic (filtOn _mcPos _machines)
-        <> singleSPic (anyTargeting cfig w)
+        <> anyTargeting cfig w
   where
     foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))