justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Rename help text-> footer text, rename tractor param

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