Allow for events to do io

This commit is contained in:
2021-11-29 01:02:15 +00:00
parent 8832a73d86
commit 3a605b8156
13 changed files with 127 additions and 142 deletions
+21 -20
View File
@@ -24,7 +24,7 @@ import SDL (MouseButton (..))
hudDrawings :: Configuration -> World -> Picture
hudDrawings cfig w = pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
, renderListAt (halfWidth cfig) 0 cfig w $ map (,white) (_testString w w)
, renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w)
, selectionText
]
where
@@ -46,19 +46,19 @@ subInventoryDisplay cfig w = case _inventoryMode w of
TweakInventory -> pictures
[ mCurs it cfig w
, cursorAt 120 col 5 0 iPos cfig
, cursorsZ cfig w iPos it
, displayMidList cfig w (ammoTweakStrings it) "TWEAK"
, cursorsZ cfig iPos it
, displayMidList cfig (ammoTweakStrings it) "TWEAK"
]
CombineInventory -> invHead cfig w "COMBINE"
InspectInventory -> invHead cfig w "INSPECT"
CombineInventory -> invHead cfig "COMBINE"
InspectInventory -> invHead cfig "INSPECT"
where
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
iPos = _crInvSel $ _creatures w IM.! _yourID w
it = yourItem w
col = itCol it
cursorsZ :: Configuration -> World -> Int -> Item -> Picture
cursorsZ cfig w ipos it = case it ^? wpAmmo . aoType . amParamSel of
cursorsZ :: Configuration -> Int -> Item -> Picture
cursorsZ cfig ipos it = case it ^? wpAmmo . aoType . amParamSel of
Nothing -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5))
Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
where
@@ -96,17 +96,20 @@ mCurs it cfig w = case it ^? wpAmmo . aoType . amParamSel of
pjTweakString :: PjParam -> String
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
displayMidList :: Configuration -> World -> [String] -> String -> Picture
displayMidList cfig w strs s =
invHead cfig w s
`appendPic` renderListAt 150 (-60) cfig w (map (,white) strs)
displayMidList :: Configuration -> [String] -> String -> Picture
displayMidList cfig strs s = invHead cfig s
`appendPic` renderListAt 150 (-60) cfig (strs <&> (,white))
invHead :: Configuration -> World -> String -> Picture
invHead cfig w s = winScale cfig . translate (-130) (halfHeight cfig - 40) . dShadCol white . scale 0.4 0.4 $ text s
invHead :: Configuration -> String -> Picture
invHead cfig s = winScale cfig
. translate (-130) (halfHeight cfig - 40)
. dShadCol white
. scale 0.4 0.4
$ text s
renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
{-# INLINE renderItemMapAt #-}
renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
displayInv :: Int -> Configuration -> World -> Picture
displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
@@ -119,7 +122,7 @@ displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
drawLocations :: Configuration -> World -> Picture
drawLocations cfig w = pictures $
renderListAt 0 0 cfig w locs
renderListAt 0 0 cfig locs
: zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
++ mapOverlay cfig w
++ [mainListCursor white iPos cfig]
@@ -134,7 +137,6 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
where
f :: Int -> Point2
f i = V2 ( 15 - halfWidth cfig ) ( 2.5 + halfHeight cfig - (20 * fromIntegral i))
--g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w)
h :: String -> Point2 -> Point2
h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
@@ -156,8 +158,7 @@ mapWall cfig w wl =
{- | Pictures of popup text for items close to your position.-}
closeObjectTexts :: Configuration -> World -> Picture
closeObjectTexts cfig w = pictures $
renderListAt pushout (negate 20 * fromIntegral invPos)
cfig w (map colAndText $ _closeObjects w)
renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
: maybeToList maybeLine
where
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
@@ -239,8 +240,8 @@ cursorAt
-> Int -- ^ y offset (discrete)
-> Configuration
-> Picture
cursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
cursorAt wth col xoff yoff yint cfig = winScale cfig
. translate (xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20)
. color col
$ line
[V2 wth 12.5