Cleanup, stop drawing space characters
This commit is contained in:
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
--{-# OPTIONS_GHC -fno-full-laziness #-}
|
--{-# OPTIONS_GHC -fno-full-laziness #-}
|
||||||
|
|
||||||
@@ -195,11 +195,10 @@ updateSection sis mcsel availablelines ss =
|
|||||||
scurs = do
|
scurs = do
|
||||||
csel <- mcsel
|
csel <- mcsel
|
||||||
(_, si) <- IM.lookupGE csel sis -- this is not right?
|
(_, si) <- IM.lookupGE csel sis -- this is not right?
|
||||||
let cpos = sum (fmap ( _siHeight) . fst . IM.split csel $ sis)
|
let cpos = sum (fmap _siHeight . fst . IM.split csel $ sis)
|
||||||
csize = length $ _siPictures si
|
csize = length $ _siPictures si
|
||||||
ccolor = _siColor si
|
ccolor = _siColor si
|
||||||
return $ SectionCursor (cpos - offset) csize ccolor
|
return $ SectionCursor (cpos - offset) csize ccolor
|
||||||
--return $ SectionCursor (cpos - offset) 1 ccolor
|
|
||||||
nocursoroffset =
|
nocursoroffset =
|
||||||
if length allstrings - oldoffset <= availablelines
|
if length allstrings - oldoffset <= availablelines
|
||||||
then max 0 (length allstrings - availablelines)
|
then max 0 (length allstrings - availablelines)
|
||||||
@@ -242,19 +241,15 @@ updateSection sis mcsel availablelines ss =
|
|||||||
| otherwise = tweakfirst shownstrings
|
| otherwise = tweakfirst shownstrings
|
||||||
moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
|
moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
|
||||||
allstrings :: [(Color, Picture)]
|
allstrings :: [(Color, Picture)]
|
||||||
--allstrings = foldMap g sis
|
|
||||||
allstrings = IM.elems $ overlapSelectionItems $ IM.elems sis
|
allstrings = IM.elems $ overlapSelectionItems $ IM.elems sis
|
||||||
shownstrings = drop offset allstrings
|
shownstrings = drop offset allstrings
|
||||||
--h (col, str) = color col . text $ theindent ++ str
|
h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
|
||||||
h (col, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
|
|
||||||
theindent = replicate (_ssIndent ss) ' '
|
theindent = replicate (_ssIndent ss) ' '
|
||||||
--xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
--xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
||||||
g si = map (_siColor si,) $ _siPictures si
|
|
||||||
|
|
||||||
overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Color, Picture)
|
overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Color, Picture)
|
||||||
overlapSelectionItems = go 0
|
overlapSelectionItems = go 0
|
||||||
where
|
where
|
||||||
--go :: Int -> [SelectionItem a] -> IM.IntMap (Picture,Color)
|
|
||||||
go _ [] = mempty
|
go _ [] = mempty
|
||||||
go i (si : xs) = doinsert $ go (i + _siHeight si) xs
|
go i (si : xs) = doinsert $ go (i + _siHeight si) xs
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -15,7 +15,7 @@ import Picture.Base
|
|||||||
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
|
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
|
||||||
invSelectionItem cr i it =
|
invSelectionItem cr i it =
|
||||||
SelectionItem
|
SelectionItem
|
||||||
{ _siPictures = (pics & ix 0 %~ (++ anyequippos ++ anyhotkey))
|
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
|
||||||
, _siHeight = itSlotsTaken it
|
, _siHeight = itSlotsTaken it
|
||||||
, _siIsSelectable = True
|
, _siIsSelectable = True
|
||||||
, _siColor = col
|
, _siColor = col
|
||||||
|
|||||||
@@ -21,7 +21,7 @@ itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it
|
|||||||
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
|
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
|
||||||
|
|
||||||
zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
|
zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
|
||||||
zipWithDefaults f g h xs ys = go xs ys
|
zipWithDefaults f g h = go
|
||||||
where
|
where
|
||||||
go [] bs = map g bs
|
go [] bs = map g bs
|
||||||
go as [] = map f as
|
go as [] = map f as
|
||||||
@@ -113,7 +113,7 @@ showReloadProgress' cr itm = case ic ^? laSource of
|
|||||||
x <- ic ^? laSource . _InternalSource . iaLoaded
|
x <- ic ^? laSource . _InternalSource . iaLoaded
|
||||||
return $ show x
|
return $ show x
|
||||||
Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic)
|
Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic)
|
||||||
Just AboveSource -> fromMaybe "XXXX" $ do
|
Just AboveSource -> fromMaybe "||||" $ do
|
||||||
i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
|
i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
|
||||||
_ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
|
_ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
|
||||||
--return $ showIntKMG' x
|
--return $ showIntKMG' x
|
||||||
|
|||||||
@@ -19,7 +19,6 @@ import Dodge.Data.Config
|
|||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.ScreenPos
|
import Dodge.ScreenPos
|
||||||
import Dodge.SelectionList
|
import Dodge.SelectionList
|
||||||
import Dodge.SelectionSections
|
|
||||||
import Geometry
|
import Geometry
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import ListHelp
|
import ListHelp
|
||||||
@@ -86,7 +85,6 @@ stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
|
|||||||
selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
|
selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
|
||||||
selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
|
selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
|
||||||
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
||||||
--yint <- selSecYint i j sss
|
|
||||||
yint <- sss ^? sssSections . ix i . ssCursor . _Just . scurPos
|
yint <- sss ^? sssSections . ix i . ssCursor . _Just . scurPos
|
||||||
xint <- sss ^? sssSections . ix i . ssIndent
|
xint <- sss ^? sssSections . ix i . ssIndent
|
||||||
si <- sss ^? sssSections . ix i . ssItems . ix j
|
si <- sss ^? sssSections . ix i . ssItems . ix j
|
||||||
|
|||||||
+3
-1
@@ -329,7 +329,9 @@ stringToList gap = concatMap (uncurry charToTuple) . zip [0, 100 + gap ..]
|
|||||||
|
|
||||||
charToTuple :: Float -> Char -> [(Point3, Point4, Point3)]
|
charToTuple :: Float -> Char -> [(Point3, Point4, Point3)]
|
||||||
{-# INLINE charToTuple #-}
|
{-# INLINE charToTuple #-}
|
||||||
charToTuple xoff c = [f 0 0, f 1 0, f 1 1, f 0 0, f 1 1, f 0 1]
|
charToTuple xoff c
|
||||||
|
| fromEnum c == 32 = [] -- don't draw space characters
|
||||||
|
| otherwise = [f 0 0, f 1 0, f 1 1, f 0 0, f 1 1, f 0 1]
|
||||||
where
|
where
|
||||||
f x y = (V3 (xoff + x * 100) (y * 200) 0, white, V3 x (1 - y) charnum)
|
f x y = (V3 (xoff + x * 100) (y * 200) 0, white, V3 x (1 - y) charnum)
|
||||||
-- textures in opengl have origins at the lower left, my char array has its
|
-- textures in opengl have origins at the lower left, my char array has its
|
||||||
|
|||||||
Reference in New Issue
Block a user