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

Work on cursor for lists

Browse Source
This commit is contained in:
justin
2023-05-10 01:44:42 +01:00
parent 93519345de
commit cd42e29012
11 changed files with 53 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+1 -1
View File
@@ -16,7 +16,7 @@ data ListDisplayParams = ListDisplayParams
, _ldpPosY :: Float
, _ldpScale :: Float
, _ldpVerticalGap :: Float
, _ldpCursorType :: CursorType
, _ldpCursorSides :: [CardinalPoint]
, _ldpWidth :: SelectionWidth
-- , _ldpSizeRestriction :: SelectionSizeRestriction
}
src/Dodge/Debug/Picture.hs
+1 -1
View File
@@ -124,7 +124,7 @@ debugDraw :: Configuration -> World -> Picture
debugDraw cfig w
| Enable_debug `S.member` _debug_booleans cfig =
pic
<> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ listPicturesAt $ map text ts))
<> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
| otherwise = mempty
where
pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
src/Dodge/ListDisplayParams.hs
+3 -3
View File
@@ -19,14 +19,14 @@ defaultListDisplayParams =
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
, _ldpCursorType = NoCursor
, _ldpCursorSides = mempty
, _ldpWidth = FixedSelectionWidth 15
}
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w =
defaultListDisplayParams
& ldpCursorType .~ BorderCursor selcursortype
& ldpCursorSides .~ selcursortype
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where
selcursortype
@@ -41,7 +41,7 @@ secondColumnParams =
defaultListDisplayParams
& ldpPosX .~ subInvX
& ldpPosY .~ 60
& ldpCursorType .~ BorderCursor [North, South, West]
& ldpCursorSides .~ [North, South, West]
subInvX :: Float
subInvX = 9 * fromIntegral topInvW + 50
src/Dodge/Menu.hs
+1 -1
View File
@@ -28,7 +28,7 @@ import Text.Read
splashMenu :: Universe -> ScreenLayer
splashMenu u =
initializeOptionMenu "AMNESIS" splashMenuOptions NoPositionedMenuOption u
initializeOptionMenu "GAME TITLE" splashMenuOptions NoPositionedMenuOption u
& scOptionFlag .~ SplashOptions
splashMenuOptions :: [MenuOption]
src/Dodge/Menu/Option.hs
+1 -1
View File
@@ -19,7 +19,7 @@ optionListDisplayParams =
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpWidth = FixedSelectionWidth 25
, _ldpCursorType = BorderCursor [North, South, West]
, _ldpCursorSides = [North, South, West]
}
initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer
src/Dodge/Render/HUD.hs
+2 -2
View File
@@ -119,8 +119,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
curpos <- selSecSelPos i' j sss
let midtext str = toTopLeft cfig $ translate 252 0 $ listTextPictureAtScale 10 1 curpos (text str)
let extratext str = toTopLeft cfig $ translate 432 0 $ listTextPictureAtScale 10 1 curpos (text (str ++ deactivatetext))
let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
return $
toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es))
<> case ae of
src/Dodge/Render/List.hs
+34 -23
View File
@@ -1,10 +1,10 @@
module Dodge.Render.List (
renderListAt,
listCursorNSW,
listPicturesAt,
drawList,
drawSelectionList,
listPicturesAtScaleOff,
listTextPictureAtScale,
drawListElement,
selSecDrawCursor,
dShadCol,
listPicturesAtOff,
@@ -26,13 +26,16 @@ import Picture
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionList ldps cfig sl =
toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0
(makeSelectionListPictures sl)
)
<> drawSelectionCursor ldps sl
toTopLeft
cfig
( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
listPicturesAtScaleOff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0
(makeSelectionListPictures sl)
)
<> drawSelectionCursor ldps sl
)
makeSelectionListPictures :: SelectionList a -> [Picture]
@@ -44,12 +47,20 @@ drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture
drawCursorAt ldps mi lis = fromMaybe mempty $ do
i <- mi
selit <- lis !? i
f <- case _ldpCursorType ldps of
BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
NoCursor -> Nothing
let j = sum . map _siHeight $ take i lis
col = _siColor selit
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit)
return $
listCursorChooseBorderScale
(_ldpVerticalGap ldps)
(_ldpScale ldps)
(ldps ^. ldpCursorSides)
(_ldpPosX ldps + (9 * fromIntegral (_siOffX selit)))
(_ldpPosY ldps)
j
0
col
wdth
(_siHeight selit)
where
wdth = case _ldpWidth ldps of
FixedSelectionWidth x -> x
@@ -65,18 +76,18 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
_ -> fmap (+ 1)
listPicturesAtOff :: Int -> [Picture] -> Picture
listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..]
listPicturesAtOff = listPicturesAtScaleOff 10 1
listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesAtScaleOff ygap s i =
mconcat
. zipWith (listTextPictureAtScale ygap s) [i ..]
. zipWith (drawListElement ygap s) [i ..]
stackPicturesAt :: [Picture] -> Picture
stackPicturesAt = stackPicturesAtOff 0
stackPicturesAtOff :: Int -> [Picture] -> Picture
stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..]
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..]
selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
@@ -120,7 +131,7 @@ listCursorChooseBorderScale ::
listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize =
translate
(xoff + (10 * s * (fromIntegral xint -1)))
( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
(- (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
where
@@ -165,18 +176,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
-- thescale = hw * 0.02 / fromIntegral (length str)
-- hw = halfWidth cfig
listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture
listTextPictureAtScale ygap s yint =
drawListElement :: Float -> Float -> Int -> Picture -> Picture
drawListElement ygap s yint =
translate 0 (negate ((s * 10 + ygap) * (fromIntegral yint + 1)))
. scale (s * 0.1) (s * 0.1)
renderListAt :: Float -> Float -> [(String, Color)] -> Picture
renderListAt tx ty = translate tx (-ty) . listPicturesAt . map (\(str, col) -> color col $ text str)
renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
-- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen
listPicturesAt :: [Picture] -> Picture
listPicturesAt = listPicturesAtScaleOff 10 1 0
drawList :: [Picture] -> Picture
drawList = listPicturesAtScaleOff 10 1 0
--TODO put the following functions in an appropriate place
@@ -186,7 +197,7 @@ dShadCol :: Color -> Picture -> Picture
dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
toTopLeft :: Configuration -> Picture -> Picture
toTopLeft cfig = translate (-hw) (hh)
toTopLeft cfig = translate (- hw) (hh)
where
hw = halfWidth cfig
hh = halfHeight cfig
src/Dodge/Render/MenuScreen.hs
+8 -10
View File
@@ -3,10 +3,10 @@ module Dodge.Render.MenuScreen (
drawMenuScreen,
) where
import Dodge.Data.SelectionList
import Dodge.Render.List
import Dodge.Base.Window
import Dodge.Data.SelectionList
import Dodge.Data.Universe
import Dodge.Render.List
import Picture
drawMenuScreen :: Configuration -> ScreenLayer -> Picture
@@ -15,7 +15,7 @@ drawMenuScreen cfig screen = case screen of
drawOptions ldps cfig titf selpos
InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help
drawInputMenu ::
drawInputMenu ::
Configuration ->
-- | Title
String ->
@@ -23,7 +23,7 @@ drawInputMenu ::
String ->
Picture
drawInputMenu cfig title footer =
pictures
pictures
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
@@ -38,17 +38,15 @@ drawOptions ::
SelectionList a ->
Picture
drawOptions ldps cfig title sl =
pictures
[ darkenBackground cfig
, drawTitle cfig title
, drawSelectionList ldps cfig sl
]
darkenBackground cfig
<> drawTitle cfig title
<> drawSelectionList ldps cfig sl
darkenBackground :: Configuration -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
drawTitle :: Configuration -> String -> Picture
drawTitle cfig = translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
drawTitle cfig = translate (- hw) (hh -80) . scale 0.4 0.4 . text
where
hh = halfHeight cfig
hw = halfWidth cfig
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -19,7 +19,7 @@ fixedCoordPictures u =
drawMenuOrHUD cfig u
<> drawConcurrentMessage u
<> customMouseCursor u
<> toTopLeft cfig (translate (halfWidth cfig) 0 $ listPicturesAt (map text (_uvTestString u u)))
<> toTopLeft cfig (translate (halfWidth cfig) 0 $ drawList (map text (_uvTestString u u)))
<> displayFrameTicks u
where
cfig = _uvConfig u
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -143,7 +143,7 @@ extraPics cfig u =
<> foldMap (`_debugPic` u) (_uvDebug u)
<> setLayer FixedCoordLayer
(toTopLeft cfig . translate (1.3* halfWidth cfig) 0
. listPicturesAt
. drawList
. take 50 . drop (u ^. uvDebugMessageOffset)
. map text $ foldMap (`_debugMessage` u) (_uvDebug u))
where
src/Dodge/SelectionSections/Draw.hs
-1
View File
@@ -4,7 +4,6 @@ import Picture.Base
import Dodge.Data.CardinalPoint
import Control.Lens
import Data.Maybe
import Picture.Data
import Dodge.Data.Config
import Dodge.Render.List
import Dodge.Data.SelectionList