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

Allow for events to do io

Browse Source
This commit is contained in:
justin
2021-11-29 01:02:15 +00:00
parent 8832a73d86
commit 3a605b8156
13 changed files with 127 additions and 142 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+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
src/Dodge/Render/List.hs
+4 -5
View File
@@ -9,20 +9,19 @@ import Dodge.Base.Window
import Dodge.WinScale
import Picture
renderListAt :: Float -> Float -> Configuration -> World -> [(String,Color)] -> Picture
renderListAt tx ty cfig w =
concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig w) [0..]
renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
renderListAt tx ty cfig =
concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
listPairAt
:: Float -- ^ x offset
-> Float -- ^ y offset
-> Configuration
-> World
-> Int -- ^ y offset (discrete)
-> (String,Color) -- ^ The text item
-> Picture
{-# INLINE listPairAt #-}
listPairAt xoff yoff cfig w yint (s,col)
listPairAt xoff yoff cfig yint (s,col)
= translate (xoff + 15 - halfWidth cfig) (yoff + halfHeight cfig - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
. dShadCol col
src/Dodge/Render/MenuScreen.hs
+16 -16
View File
@@ -16,7 +16,7 @@ menuScreen w screen = case screen of
(WaitScreen sf _) -> drawOptions w (sf w) []
(InputScreen s) -> drawOptions w ('>':s) []
(DisplayScreen sd ) -> sd w
(ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) (_uvWorld w) title pairs
(ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) title pairs
--displayStringList :: World -> [String] -> Picture
--displayStringList w ss = pictures
@@ -28,15 +28,15 @@ menuScreen w screen = case screen of
-- ys = [0,22..]
-- f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
drawTwoColumnsScreen :: Configuration -> World -> String -> [(String,String)] -> Picture
drawTwoColumnsScreen cfig w title lps = pictures
drawTwoColumnsScreen :: Configuration -> String -> [(String,String)] -> Picture
drawTwoColumnsScreen cfig title lps = pictures
[darkenBackground cfig
,drawTitle cfig w title
,drawTwoColumns cfig w lps
,drawTitle cfig title
,drawTwoColumns cfig lps
]
drawTwoColumns :: Configuration -> World -> [(String,String)] -> Picture
drawTwoColumns cfig w lps = pictures $ zipWith f [hh-100,hh-130..] lps
drawTwoColumns :: Configuration -> [(String,String)] -> Picture
drawTwoColumns cfig lps = pictures $ zipWith f [hh-100,hh-130..] lps
where
f y (s1,s2) = translate (50-hw) y $ sc $ rightPad ln '.' s1 ++ s2
sc = scale 0.15 0.15 . color white . text
@@ -49,11 +49,12 @@ drawOptions
-> String -- ^ Title
-> [MenuOption] -- ^ Options
-> Picture
drawOptions w title ops = pictures $
[darkenBackground (_config w)
,drawTitle (_config w) (_uvWorld w) title]
++
zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..]
drawOptions u title ops = pictures $
[darkenBackground cfig
, drawTitle cfig title] ++
zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s)
(map (menuOptionToString u) ops')
[hh-100,hh-150 ..]
where
ops' = filter notInvisible ops
notInvisible InvisibleToggle {} = False
@@ -61,13 +62,13 @@ drawOptions w title ops = pictures $
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
hh = halfHeight cfig
hw = halfWidth cfig
cfig = _config w
cfig = _config u
darkenBackground :: Configuration -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
drawTitle :: Configuration -> World -> String -> Picture
drawTitle cfig w = placeString (-hw + 30) (hh - 50) 0.4
drawTitle :: Configuration -> String -> Picture
drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4
where
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
hh = halfHeight cfig
@@ -76,7 +77,6 @@ drawTitle cfig w = placeString (-hw + 30) (hh - 50) 0.4
menuOptionToString :: Universe -> MenuOption -> String
menuOptionToString w mo = theKeys ++ _moString mo w
where
theKeys :: String
theKeys = case mo of
Toggle {_moKey = k} -> stc k : ":"
Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
src/Dodge/Render/Picture.hs
+8 -10
View File
@@ -3,7 +3,7 @@ module Dodge.Render.Picture
( fixedCoordPictures
) where
import Dodge.Data
import Dodge.Base.Window
--import Dodge.Base.Window
import Dodge.WinScale
import Dodge.Picture.Layer
import Dodge.Render.HUD
@@ -12,20 +12,18 @@ import Geometry
import Picture
fixedCoordPictures :: Universe -> Picture
fixedCoordPictures w = case _menuLayers w of
fixedCoordPictures u = case _menuLayers u of
[] -> pictures
[ hudDrawings (_config w) (_uvWorld w)
, customMouseCursor (_config w) (_uvWorld w)
[ hudDrawings cfig w
, customMouseCursor cfig w
]
(lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay
(lay:_) -> setDepth (-1) . winScale cfig . onLayer MenuDepth $ menuScreen u lay
where
scaler = setDepth (-1) . winScale cfig
cfig = _config w
w = _uvWorld u
cfig = _config u
customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w =
winScale cfig
customMouseCursor cfig w = winScale cfig
. uncurryV translate (_mousePos w)
. color white
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -7,7 +7,7 @@ import Dodge.Config.Data
import Dodge.Picture.SizeInvariant
import Dodge.Data
import Dodge.Base
import Dodge.Base.Window
--import Dodge.Base.Window
import Dodge.SoundLogic.LoadSound
import Dodge.Graph
import Dodge.GameRoom