Rename help text-> footer text, rename tractor param

This commit is contained in:
2022-03-20 18:13:34 +00:00
parent d19bd5c327
commit ff93d1d041
5 changed files with 47 additions and 44 deletions
+5 -2
View File
@@ -174,7 +174,10 @@ data ScreenLayer
, _scOptionFlag :: OptionScreenFlag , _scOptionFlag :: OptionScreenFlag
} }
| ColumnsScreen String [(String,String)] | ColumnsScreen String [(String,String)]
| InputScreen String String | InputScreen
{ _scInput :: String
, _scFooter :: String
}
| WaitScreen | WaitScreen
{ _scWaitMessage :: Universe -> String { _scWaitMessage :: Universe -> String
, _scWaitTime :: Int , _scWaitTime :: Int
@@ -616,7 +619,7 @@ data ItemParams
, _shellThrustDelay :: Int , _shellThrustDelay :: Int
} }
| Refracting {_phaseV :: Float} | Refracting {_phaseV :: Float}
| Traction {_power :: Point2} | Attracting {_attractionPower :: Point2}
| BulletShooter -- this should possibly be moved into ammo type | BulletShooter -- this should possibly be moved into ammo type
{ _muzVel :: Float { _muzVel :: Float
, _rifling :: Float , _rifling :: Float
+6 -6
View File
@@ -9,12 +9,12 @@ import Control.Monad
import Control.Lens import Control.Lens
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Data.List (isPrefixOf, isInfixOf, intercalate) import Data.List --(isPrefixOf, isInfixOf, intercalate)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import LensHelp import LensHelp
import qualified Debug.Trace --import qualified Debug.Trace
import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram) --import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
import Dodge.Data (Universe(Universe)) --import Dodge.Data (Universe(Universe))
applyTerminalString :: String -> Universe -> Universe applyTerminalString :: String -> Universe -> Universe
applyTerminalString "NOCLIP" = config . debug_noclip %~ not applyTerminalString "NOCLIP" = config . debug_noclip %~ not
@@ -64,7 +64,8 @@ applySetTerminalString var = case key' of
key' = if val' == Nothing then "" else key key' = if val' == Nothing then "" else key
autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe) autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
autoCompleteTerminal s help = return . (popScreen' >=> pushScreen' (InputScreen input_str valid_commands)) autoCompleteTerminal s _ = return .
(popScreen' >=> pushScreen' (InputScreen input_str valid_commands))
where where
(key, val) = getSplitString $ tail s (key, val) = getSplitString $ tail s
command_options = case val of command_options = case val of
@@ -98,7 +99,6 @@ validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
validTerminalCommands "god" = ["on", "off"] validTerminalCommands "god" = ["on", "off"]
validTerminalCommands _ = ["set", "spawn", "god"] validTerminalCommands _ = ["set", "spawn", "god"]
loadme :: a loadme :: a
loadme = undefined loadme = undefined
+4 -5
View File
@@ -5,7 +5,7 @@ module Dodge.Event.Menu
where where
import Dodge.Data import Dodge.Data
import Dodge.Debug.Terminal import Dodge.Debug.Terminal
import Dodge.Menu --import Dodge.Menu
import Dodge.Menu.PushPop import Dodge.Menu.PushPop
import Data.Maybe import Data.Maybe
@@ -13,12 +13,12 @@ import Control.Monad
--import Control.Lens --import Control.Lens
import SDL import SDL
import Control.Lens ((%~)) import Control.Lens ((%~))
import qualified Debug.Trace --import qualified Debug.Trace
handleTextInMenu :: ScreenLayer -> [Char] -> Universe -> IO (Maybe Universe) handleTextInMenu :: ScreenLayer -> [Char] -> Universe -> IO (Maybe Universe)
handleTextInMenu mState text = case mState of handleTextInMenu mState text = case mState of
InputScreen s help-> return . (popScreen' >=> pushScreen' (InputScreen new_text help)) InputScreen s help -> return . (popScreen' >=> pushScreen' (InputScreen new_text help))
where where
new_text new_text
-- Text events occur after key events so ignore the first -- Text events occur after key events so ignore the first
@@ -27,7 +27,6 @@ handleTextInMenu mState text = case mState of
| otherwise = s ++ text | otherwise = s ++ text
_ -> return . Just _ -> return . Just
handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKeyInMenu mState scode = case mState of handlePressedKeyInMenu mState scode = case mState of
OptionScreen { _scOptions = mos, _scDefaultEff = defeff} OptionScreen { _scOptions = mos, _scDefaultEff = defeff}
@@ -45,7 +44,7 @@ handlePressedKeyInMenu mState scode = case mState of
-- Ignore (text input now handled by handleText) -- Ignore (text input now handled by handleText)
_ -> return . (popScreen' >=> pushScreen' (InputScreen s help)) _ -> return . (popScreen' >=> pushScreen' (InputScreen s help))
where where
dropLast [x] = ['>'] dropLast [_] = ['>']
dropLast (x:xs) = init (x:xs) dropLast (x:xs) = init (x:xs)
dropLast _ = ['>'] dropLast _ = ['>']
+6 -6
View File
@@ -151,7 +151,7 @@ tractorGun = lasGun
, _dimPortage = HeldItem 5 30 , _dimPortage = HeldItem 5 30
, _dimSPic = tractorGunPic , _dimSPic = tractorGunPic
} }
, _itParams = Traction {_power = 1} , _itParams = Attracting {_attractionPower = 1}
, _itTweaks = Tweakable , _itTweaks = Tweakable
{ _tweakParams = IM.fromList [(0,tractorGunTweak)] { _tweakParams = IM.fromList [(0,tractorGunTweak)]
, _tweakSel = 0 , _tweakSel = 0
@@ -166,10 +166,10 @@ tractorGunTweak = TweakParam
, _nameTweak = "TRACTION POWER" , _nameTweak = "TRACTION POWER"
} }
where where
thetweak 0 = itParams . power .~ 1 thetweak 0 = itParams . attractionPower .~ 1
thetweak 1 = itParams . power .~ -1 thetweak 1 = itParams . attractionPower .~ -1
thetweak 2 = itParams . power .~ -10 thetweak 2 = itParams . attractionPower .~ -10
thetweak 3 = itParams . power .~ 0 thetweak 3 = itParams . attractionPower .~ 0
thetweak _ = id thetweak _ = id
showPower 0 = "+" showPower 0 = "+"
showPower 1 = "-" showPower 1 = "-"
@@ -242,7 +242,7 @@ aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
dir = _crDir cr dir = _crDir cr
outpos = collidePointWalls cpos xpos outpos = collidePointWalls cpos xpos
$ wallsAlongLine cpos xpos w $ wallsAlongLine cpos xpos w
power = _power . _itParams $ _crInv cr IM.! _crInvSel cr power = _attractionPower . _itParams $ _crInv cr IM.! _crInvSel cr
tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Point2 -> Prop tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Point2 -> Prop
tractorBeamAt i pos outpos dir power = ProjectileTimed tractorBeamAt i pos outpos dir power = ProjectileTimed
+8 -7
View File
@@ -13,7 +13,7 @@ menuScreen w screen = case screen of
OptionScreen {_scTitle = titf, _scOptions = mos} OptionScreen {_scTitle = titf, _scOptions = mos}
-> drawOptions w (titf w) mos "Use keys to navigate the menu" -> drawOptions w (titf w) mos "Use keys to navigate the menu"
(WaitScreen sf _) -> drawOptions w (sf w) [] "" (WaitScreen sf _) -> drawOptions w (sf w) [] ""
(InputScreen s help) -> drawOptions w (s) [] help (InputScreen inputstr help) -> drawOptions w inputstr [] help
(DisplayScreen sd ) -> sd w (DisplayScreen sd ) -> sd w
(ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) title pairs (ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) title pairs
@@ -49,9 +49,11 @@ drawOptions
-> [MenuOption] -- ^ Options -> [MenuOption] -- ^ Options
-> String -- ^ Help Text -> String -- ^ Help Text
-> Picture -> Picture
drawOptions u title ops help = pictures $ drawOptions u title ops footer = pictures $
[darkenBackground cfig [ darkenBackground cfig
, drawTitle cfig title, drawHelpText cfig help red] ++ , drawTitle cfig title
, drawFooterText cfig red footer
] ++
zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s) zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s)
(map (menuOptionToString u) ops') (map (menuOptionToString u) ops')
[hh-100,hh-150 ..] [hh-100,hh-150 ..]
@@ -74,10 +76,9 @@ drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4
hh = halfHeight cfig hh = halfHeight cfig
hw = halfWidth cfig hw = halfWidth cfig
drawHelpText :: Configuration -> String -> Color -> Picture drawFooterText :: Configuration -> Color -> String -> Picture
drawHelpText cfig col = placeString (-hw + 30) (-hh+10) 0.1 col drawFooterText cfig col = translate (-hw + 30) (-hh+10) . scale 0.1 0.1 . color col . text
where where
placeString x y sc t col = translate x y $ scale sc sc $ color col $ text t
hh = halfHeight cfig hh = halfHeight cfig
hw = halfWidth cfig hw = halfWidth cfig