Allow to change menu options with rclick, move towards shader experiment

src/Dodge/Data/Config.hs

@@ -16,7 +16,7 @@ data Configuration = Configuration
     , _volume_music :: Float
     , _graphics_wall_textured :: Bool
     , _graphics_cloud_shadows :: Bool
-    , _graphics_object_shadows :: Bool
+    , _graphics_object_shadows :: ObjectShadows
     , _graphics_resolution_factor :: ResFactor
     , _windowX :: Float
     , _windowY :: Float
@@ -60,6 +60,9 @@ data DebugBool
 data ResFactor = FullRes | HalfRes | QuarterRes
     deriving (Show, Eq, Ord, Enum, Bounded)
 
+data ObjectShadows = GeoObjShads | CPUObjShads | NoObjShads
+    deriving (Show, Eq, Ord, Enum, Bounded)
+
 data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
     deriving (Show, Eq, Ord, Enum, Bounded)
 
@@ -74,10 +77,10 @@ defaultConfig =
     Configuration
         { _volume_master = 1
         , _volume_sound = 1
-        , _volume_music = 1
+        , _volume_music = 0
         , _graphics_wall_textured = True
         , _graphics_cloud_shadows = True
-        , _graphics_object_shadows = True
+        , _graphics_object_shadows = GeoObjShads
         , _graphics_resolution_factor = FullRes
         , _windowX = 800
         , _windowY = 600
@@ -93,6 +96,7 @@ debugOn db = S.member db . _debug_booleans
 
 makeLenses ''Configuration
 deriveJSON defaultOptions ''ResFactor
+deriveJSON defaultOptions ''ObjectShadows
 deriveJSON defaultOptions ''RoomClipping
 deriveJSON defaultOptions ''DebugBool
 deriveJSON defaultOptions ''Configuration

src/Dodge/Data/Universe.hs

@@ -60,7 +60,7 @@ data ScreenLayer
         , _scOffset :: Int
         , _scPositionedMenuOption :: PositionedMenuOption
         , _scOptionFlag :: OptionScreenFlag
-        , _scSelectionList :: SelectionList (Universe -> Universe)
+        , _scSelectionList :: SelectionList (Universe -> Universe,Universe->Universe)
         , _scAvailableLines :: Int
         , _scListDisplayParams :: ListDisplayParams
         }

src/Dodge/Menu.hs

@@ -184,7 +184,7 @@ graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
     [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
     , makeBoolOption graphics_wall_textured "WALL TEXTURES"
-    , makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
+    , makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id
     , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
     ]
 

src/Dodge/Menu/Option.hs

@@ -1,5 +1,6 @@
 module Dodge.Menu.Option where
 
+import Control.Applicative
 --import Dodge.ScodeToChar
 import Dodge.Default.SelectionList
 import Data.Maybe
@@ -61,14 +62,15 @@ makeOptionsSelectionList ::
     Universe ->
     [MenuOption] ->
     PositionedMenuOption ->
-    SelectionList (Universe -> Universe)
+    SelectionList (Universe -> Universe,Universe -> Universe)
 makeOptionsSelectionList maxlines mselpos u mos pmo =
     defaultSelectionList
         { _slItems = optionsToSelections maxlines u mos pmo
         , _slSelPos = mselpos
         }
 
-optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]
+optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption 
+    -> [SelectionItem (Universe -> Universe,Universe -> Universe)]
 optionsToSelections maxlines u allops pmo = case pmo of
     NoPositionedMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops
     TopMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops)
@@ -115,7 +117,8 @@ optionValueOffset u mo = case _moString mo u of
     MODStringOption s _ -> length s
     _ -> 0
 
-menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Universe -> Universe)
+menuOptionToSelectionItem :: Universe -> Int -> MenuOption 
+    -> SelectionItem (Universe -> Universe,Universe -> Universe)
 menuOptionToSelectionItem w padAmount mo =
     SelectionItem
         { _siPictures = [optionText]
@@ -124,13 +127,14 @@ menuOptionToSelectionItem w padAmount mo =
         --, _siWidth = length optionText
         , _siColor = thecol
         , _siOffX = 0
-        , _siPayload = f
+        , _siPayload = (f,g)
         }
   where
     isselectable = case _moString mo w of
         MODBlockedString{} -> False
         _ -> True
-    f = fromMaybe id $ mo ^? moEff
+    f = fromMaybe id $ mo ^? moEff <|> mo ^? moEff1
+    g = fromMaybe id $ mo ^? moEff2
     thecol = case _moString mo w of
         MODBlockedString{} -> greyN 0.5
         _ -> white

src/Dodge/Update/Input/ScreenLayer.hs

@@ -38,7 +38,7 @@ optionScreenUpdate ::
     ScreenLayer ->
     PositionedMenuOption ->
     ListDisplayParams ->
-    SelectionList (Universe -> Universe) ->
+    SelectionList (Universe -> Universe,Universe -> Universe) ->
     Universe ->
     Universe
 optionScreenUpdate screen mop ldps sl u =
@@ -55,17 +55,24 @@ optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at Sca
     Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u
     _ -> u
 
+-- ouch this is not good
 mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
 mouseClickOptionsList screen u = fromMaybe u $ do
     sl <- screen ^? scSelectionList
     Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
         Just False -> fromMaybe u $ do
             i <- sl ^. slSelPos
-            f <- sl ^? slItems . ix i . siPayload
+            f <- sl ^? slItems . ix i . siPayload . _1
             return $ f u
-        _ -> u
+        _ -> case u ^. uvWorld . input . mouseButtons . at ButtonRight of
+            Just False -> fromMaybe u $ do
+                i <- sl ^. slSelPos
+                f <- sl ^? slItems . ix i . siPayload . _2
+                return $ f u
+            _ -> u
 
-mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
+mouseOverSelectionList :: ListDisplayParams 
+    -> SelectionList a -> Universe -> Universe
 mouseOverSelectionList ldps sl u
     | x > xl && x < xr
         && ylower == yupper