Move configuration from world to universe
This commit is contained in:
+71
-71
@@ -20,74 +20,74 @@ import Control.Lens
|
||||
import SDL (MouseButton (..))
|
||||
--import Data.Bifunctor
|
||||
|
||||
hudDrawings :: World -> Picture
|
||||
hudDrawings w = pictures
|
||||
[ winScale w . dShadCol white $ displayHP 0 w
|
||||
, renderListAt (halfWidth w) 0 w $ map (,white) (_testString w w)
|
||||
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)
|
||||
, selectionText
|
||||
]
|
||||
where
|
||||
selectionText = if _carteDisplay w
|
||||
then drawLocations w
|
||||
else drawInventory w
|
||||
then drawLocations cfig w
|
||||
else drawInventory cfig w
|
||||
|
||||
|
||||
drawInventory :: World -> Picture
|
||||
drawInventory w = subInventoryDisplay w `appendPic` displayInv 0 w
|
||||
drawInventory :: Configuration -> World -> Picture
|
||||
drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w
|
||||
|
||||
subInventoryDisplay :: World -> Picture
|
||||
subInventoryDisplay w = case _inventoryMode w of
|
||||
LockedInventory -> topInvCursor col iPos w
|
||||
subInventoryDisplay :: Configuration -> World -> Picture
|
||||
subInventoryDisplay cfig w = case _inventoryMode w of
|
||||
LockedInventory -> topInvCursor col iPos cfig w
|
||||
TopInventory -> pictures
|
||||
[ closeObjectTexts w
|
||||
, topInvCursor col iPos w
|
||||
[ closeObjectTexts cfig w
|
||||
, topInvCursor col iPos cfig w
|
||||
]
|
||||
TweakInventory -> pictures
|
||||
[ mCurs it w
|
||||
, cursorAt 120 col 5 0 iPos w
|
||||
, cursorsZ w iPos it
|
||||
, displayMidList w (ammoTweakStrings it) "TWEAK"
|
||||
[ mCurs it cfig w
|
||||
, cursorAt 120 col 5 0 iPos cfig
|
||||
, cursorsZ cfig w iPos it
|
||||
, displayMidList cfig w (ammoTweakStrings it) "TWEAK"
|
||||
]
|
||||
CombineInventory -> invHead w "COMBINE"
|
||||
InspectInventory -> invHead w "INSPECT"
|
||||
CombineInventory -> invHead cfig w "COMBINE"
|
||||
InspectInventory -> invHead cfig w "INSPECT"
|
||||
where
|
||||
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
|
||||
iPos = _crInvSel $ _creatures w IM.! _yourID w
|
||||
it = yourItem w
|
||||
col = itCol it
|
||||
|
||||
cursorsZ :: World -> Int -> Item -> Picture
|
||||
cursorsZ w ipos it = case it ^? wpAmmo . aoType . amParamSel of
|
||||
cursorsZ :: Configuration -> World -> Int -> Item -> Picture
|
||||
cursorsZ cfig w 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
|
||||
f = winScale w . color white
|
||||
hh = halfHeight w
|
||||
hw = halfWidth w
|
||||
f = winScale cfig . color white
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
|
||||
|
||||
topInvCursor :: Color -> Int -> World -> Picture
|
||||
topInvCursor col iPos w
|
||||
topInvCursor :: Color -> Int -> Configuration -> World -> Picture
|
||||
topInvCursor col iPos cfig w
|
||||
| ButtonRight `S.member` _mouseButtons w =
|
||||
cursorAt 100 col 5 0 iPos w
|
||||
`appendPic` openCursorAt 20 col 105 0 iPos w
|
||||
| otherwise = mainListCursor col iPos w
|
||||
cursorAt 100 col 5 0 iPos cfig
|
||||
`appendPic` openCursorAt 20 col 105 0 iPos cfig
|
||||
| otherwise = mainListCursor col iPos cfig
|
||||
|
||||
ammoTweakStrings :: Item -> [String]
|
||||
ammoTweakStrings it = case it ^? wpAmmo . aoType . amPjParams of
|
||||
Just l -> map pjTweakString l
|
||||
_ -> ["NOT TWEAKABLE"]
|
||||
|
||||
mCurs :: Item -> World -> Picture
|
||||
mCurs it w = case it ^? wpAmmo . aoType . amParamSel of
|
||||
mCurs :: Item -> Configuration -> World -> Picture
|
||||
mCurs it cfig w = case it ^? wpAmmo . aoType . amParamSel of
|
||||
Nothing -> []
|
||||
Just i
|
||||
| ButtonRight `S.member` _mouseButtons w ->
|
||||
pictures
|
||||
[cursorAt x white y 60 i w
|
||||
,openCursorAt 20 white (x+y) 60 i w
|
||||
[cursorAt x white y 60 i cfig
|
||||
,openCursorAt 20 white (x+y) 60 i cfig
|
||||
]
|
||||
| otherwise -> openCursorAt 140 white 155 60 i w
|
||||
| otherwise -> openCursorAt 140 white 155 60 i cfig
|
||||
where
|
||||
x = 117.5
|
||||
y = 155
|
||||
@@ -95,40 +95,40 @@ mCurs it w = case it ^? wpAmmo . aoType . amParamSel of
|
||||
pjTweakString :: PjParam -> String
|
||||
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
|
||||
|
||||
displayMidList :: World -> [String] -> String -> Picture
|
||||
displayMidList w strs s =
|
||||
invHead w s
|
||||
`appendPic` renderListAt 150 (-60) w (map (,white) strs)
|
||||
displayMidList :: Configuration -> World -> [String] -> String -> Picture
|
||||
displayMidList cfig w strs s =
|
||||
invHead cfig w s
|
||||
`appendPic` renderListAt 150 (-60) cfig w (map (,white) strs)
|
||||
|
||||
invHead :: World -> String -> Picture
|
||||
invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s
|
||||
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
|
||||
|
||||
renderItemMapAt :: Float -> Float -> World -> IM.IntMap Item -> Picture
|
||||
renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
|
||||
{-# INLINE renderItemMapAt #-}
|
||||
renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
|
||||
|
||||
displayInv :: Int -> World -> Picture
|
||||
displayInv n w = renderItemMapAt 0 0 w (_crInv cr)
|
||||
displayInv :: Int -> Configuration -> World -> Picture
|
||||
displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
|
||||
<> equipcursor
|
||||
where
|
||||
equipcursor = case _crLeftInvSel cr of
|
||||
Nothing -> mempty
|
||||
Just invid -> openCursorAt 20 yellow 105 0 invid w
|
||||
Just invid -> openCursorAt 20 yellow 105 0 invid cfig
|
||||
cr = _creatures w IM.! n
|
||||
|
||||
drawLocations :: World -> Picture
|
||||
drawLocations w = pictures $
|
||||
renderListAt 0 0 w locs
|
||||
: zipWith bConnect (displayListEndCoords w locTexts) locPoss
|
||||
++ mapOverlay w
|
||||
++ [mainListCursor white iPos w]
|
||||
drawLocations :: Configuration -> World -> Picture
|
||||
drawLocations cfig w = pictures $
|
||||
renderListAt 0 0 cfig w locs
|
||||
: zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
|
||||
++ mapOverlay cfig w
|
||||
++ [mainListCursor white iPos cfig]
|
||||
where
|
||||
iPos = _selLocation w
|
||||
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
|
||||
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
|
||||
locPoss = map (cartePosToScreen cfig w . ($ w) . fst) . IM.elems . _seenLocations $ w
|
||||
locTexts = map fst locs
|
||||
|
||||
displayListEndCoords :: World -> [String] -> [Point2]
|
||||
displayListEndCoords :: Configuration -> [String] -> [Point2]
|
||||
displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..]
|
||||
where
|
||||
f :: Int -> Point2
|
||||
@@ -138,14 +138,14 @@ displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..]
|
||||
h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
|
||||
|
||||
|
||||
mapOverlay :: World -> [Picture]
|
||||
mapOverlay w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) :
|
||||
(mapMaybe (mapWall w) . IM.elems $ _walls w)
|
||||
mapOverlay :: Configuration -> World -> [Picture]
|
||||
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) :
|
||||
(mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
|
||||
|
||||
mapWall :: World -> Wall -> Maybe Picture
|
||||
mapWall w wl =
|
||||
mapWall :: Configuration -> World -> Wall -> Maybe Picture
|
||||
mapWall cfig w wl =
|
||||
if _wlSeen wl
|
||||
then Just . color c . polygon $ map (cartePosToScreen w) [x,x +.+ n2,y +.+ n2, y]
|
||||
then Just . color c . polygon $ map (cartePosToScreen cfig w) [x,x +.+ n2,y +.+ n2, y]
|
||||
else Nothing
|
||||
where
|
||||
t = normalizeV (y -.- x)
|
||||
@@ -153,10 +153,10 @@ mapWall w wl =
|
||||
(x,y) = _wlLine wl
|
||||
c = _wlColor wl
|
||||
{- | Pictures of popup text for items close to your position.-}
|
||||
closeObjectTexts :: World -> Picture
|
||||
closeObjectTexts w = pictures $
|
||||
closeObjectTexts :: Configuration -> World -> Picture
|
||||
closeObjectTexts cfig w = pictures $
|
||||
renderListAt pushout (negate 20 * fromIntegral invPos)
|
||||
w (map colAndText $ _closeObjects w)
|
||||
cfig w (map colAndText $ _closeObjects w)
|
||||
: maybeToList maybeLine
|
||||
where
|
||||
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
|
||||
@@ -177,17 +177,17 @@ closeObjectTexts w = pictures $
|
||||
itScreenPos <- mayScreenPos
|
||||
(theText,col) <- fmap colAndText mayObj
|
||||
let textWidth = 9 * fromIntegral (length theText)
|
||||
let p = V2 (textWidth + 15 + pushout - halfWidth w)
|
||||
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
|
||||
return . winScale w . color col $ lConnect p itScreenPos
|
||||
let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
|
||||
( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
|
||||
return . winScale cfig . color col $ lConnect p itScreenPos
|
||||
|
||||
mainListCursor :: Color -> Int -> World -> Picture
|
||||
mainListCursor :: Color -> Int -> Configuration -> Picture
|
||||
mainListCursor c = openCursorAt 120 c 5 0
|
||||
|
||||
listItemAt
|
||||
:: Float -- ^ x offset
|
||||
-> Float -- ^ y offset
|
||||
-> World
|
||||
-> Configuration
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> Item -- ^ The item
|
||||
-> Picture
|
||||
@@ -220,7 +220,7 @@ openCursorAt
|
||||
-> Float -- ^ x offset
|
||||
-> Float -- ^ y offset
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> World
|
||||
-> Configuration
|
||||
-> Picture
|
||||
openCursorAt wth col xoff yoff yint w = winScale w
|
||||
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
|
||||
@@ -236,7 +236,7 @@ cursorAt
|
||||
-> Float -- ^ x offset
|
||||
-> Float -- ^ y offset
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> World
|
||||
-> Configuration
|
||||
-> Picture
|
||||
cursorAt wth col xoff yoff yint w = winScale w
|
||||
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
|
||||
@@ -249,11 +249,11 @@ cursorAt wth col xoff yoff yint w = winScale w
|
||||
,V2 wth 12.5
|
||||
]
|
||||
|
||||
displayHP :: Int -> World -> Picture
|
||||
displayHP n w = translate (halfWidth w-80) (halfHeight w-20)
|
||||
displayHP :: Int -> Configuration -> World -> Picture
|
||||
displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20)
|
||||
. scale 0.2 0.2
|
||||
. text
|
||||
. leftPad 5 ' '
|
||||
. show
|
||||
. _crHP
|
||||
$ _creatures w IM.! n
|
||||
$ _creatures w IM.! cid
|
||||
|
||||
Reference in New Issue
Block a user