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
|
||||
|
||||
@@ -6,22 +6,24 @@ module Dodge.Render.List
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base.Window
|
||||
import Dodge.WinScale
|
||||
import Picture
|
||||
|
||||
renderListAt :: Float -> Float -> World -> [(String,Color)] -> Picture
|
||||
renderListAt tx ty w =
|
||||
concatMapPic (winScale w) . zipWith (listPairAt tx ty w) [0..]
|
||||
renderListAt :: Float -> Float -> Configuration -> World -> [(String,Color)] -> Picture
|
||||
renderListAt tx ty cfig w =
|
||||
concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig w) [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 w yint (s,col)
|
||||
= translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
|
||||
listPairAt xoff yoff cfig w yint (s,col)
|
||||
= translate (xoff + 15 - halfWidth cfig) (yoff + halfHeight cfig - (20 * (fromIntegral yint+1)))
|
||||
. scale 0.1 0.1
|
||||
. dShadCol col
|
||||
$ text s
|
||||
@@ -33,6 +35,3 @@ dShadCol c p = pictures
|
||||
[ color black $ translate 1.2 (-1.2) p
|
||||
, color c p
|
||||
]
|
||||
winScale :: World -> Picture -> Picture
|
||||
{-# INLINE winScale #-}
|
||||
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
|
||||
@@ -15,47 +15,43 @@ menuScreen w screen = case screen of
|
||||
-> drawOptions w (titf w) mos
|
||||
(WaitScreen sf _) -> drawOptions w (sf w) []
|
||||
(InputScreen s) -> drawOptions w ('>':s) []
|
||||
(TerminalScreen t xs ) -> displayStringList (_uvWorld w) $ map snd $ filter (( > t) . fst) xs
|
||||
(DisplayScreen sd ) -> sd w
|
||||
(ColumnsScreen title pairs) -> drawTwoColumnsScreen (_uvWorld w) title pairs
|
||||
(ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) (_uvWorld w) title pairs
|
||||
|
||||
displayStringList :: World -> [String] -> Picture
|
||||
displayStringList w ss = pictures
|
||||
( polygon (screenBox w)
|
||||
: zipWith f ys ss
|
||||
)
|
||||
where
|
||||
hw = halfWidth w
|
||||
ys = [0,22..]
|
||||
f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
|
||||
--displayStringList :: World -> [String] -> Picture
|
||||
--displayStringList w ss = pictures
|
||||
-- ( polygon (screenBox w)
|
||||
-- : zipWith f ys ss
|
||||
-- )
|
||||
-- where
|
||||
-- hw = halfWidth w
|
||||
-- ys = [0,22..]
|
||||
-- f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
|
||||
|
||||
drawTwoColumnsScreen
|
||||
:: World
|
||||
-> String
|
||||
-> [(String,String)]
|
||||
-> Picture
|
||||
drawTwoColumnsScreen w title lps = pictures
|
||||
[darkenBackground w
|
||||
,drawTitle w title
|
||||
,drawTwoColumns w lps
|
||||
drawTwoColumnsScreen :: Configuration -> World -> String -> [(String,String)] -> Picture
|
||||
drawTwoColumnsScreen cfig w title lps = pictures
|
||||
[darkenBackground cfig
|
||||
,drawTitle cfig w title
|
||||
,drawTwoColumns cfig w lps
|
||||
]
|
||||
|
||||
drawTwoColumns :: World -> [(String,String)] -> Picture
|
||||
drawTwoColumns w lps = pictures $ zipWith f [hh-100,hh-130..] lps
|
||||
drawTwoColumns :: Configuration -> World -> [(String,String)] -> Picture
|
||||
drawTwoColumns cfig w 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
|
||||
hh = halfHeight w
|
||||
hw = halfWidth w
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
ln = maximum (map (length . fst) lps) + 3
|
||||
|
||||
drawOptions :: Universe
|
||||
drawOptions
|
||||
:: Universe
|
||||
-> String -- ^ Title
|
||||
-> [MenuOption] -- ^ Options
|
||||
-> Picture
|
||||
drawOptions w title ops = pictures $
|
||||
[darkenBackground (_uvWorld w)
|
||||
,drawTitle (_uvWorld w) title]
|
||||
[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 ..]
|
||||
where
|
||||
@@ -63,18 +59,19 @@ drawOptions w title ops = pictures $
|
||||
notInvisible InvisibleToggle {} = False
|
||||
notInvisible _ = True
|
||||
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
hh = halfHeight (_uvWorld w)
|
||||
hw = halfWidth (_uvWorld w)
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
cfig = _config w
|
||||
|
||||
darkenBackground :: World -> Picture
|
||||
darkenBackground :: Configuration -> Picture
|
||||
darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
|
||||
|
||||
drawTitle :: World -> String -> Picture
|
||||
drawTitle w = placeString (-hw + 30) (hh - 50) 0.4
|
||||
drawTitle :: Configuration -> World -> String -> Picture
|
||||
drawTitle cfig w = 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 w
|
||||
hw = halfWidth w
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
|
||||
menuOptionToString :: Universe -> MenuOption -> String
|
||||
menuOptionToString w mo = theKeys ++ _moString mo w
|
||||
|
||||
@@ -4,6 +4,7 @@ module Dodge.Render.Picture
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Base.Window
|
||||
import Dodge.WinScale
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Render.HUD
|
||||
import Dodge.Render.MenuScreen
|
||||
@@ -13,16 +14,17 @@ import Picture
|
||||
fixedCoordPictures :: Universe -> Picture
|
||||
fixedCoordPictures w = case _menuLayers w of
|
||||
[] -> pictures
|
||||
[ hudDrawings (_uvWorld w)
|
||||
, customMouseCursor (_uvWorld w)
|
||||
[ hudDrawings (_config w) (_uvWorld w)
|
||||
, customMouseCursor (_config w) (_uvWorld w)
|
||||
]
|
||||
(lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay
|
||||
where
|
||||
scaler = setDepth (-1) . scale (2 / getWindowX (_uvWorld w)) (2 / getWindowY (_uvWorld w))
|
||||
scaler = setDepth (-1) . scale (2 / getWindowX cfig) (2 / getWindowY cfig)
|
||||
cfig = _config w
|
||||
|
||||
customMouseCursor :: World -> Picture
|
||||
customMouseCursor w =
|
||||
scale (2 /getWindowX w) (2/ getWindowY w)
|
||||
customMouseCursor :: Configuration -> World -> Picture
|
||||
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] ]
|
||||
|
||||
@@ -24,33 +24,33 @@ import qualified Data.Map.Strict as M
|
||||
--import Control.Lens
|
||||
--import Data.Maybe
|
||||
|
||||
worldSPic :: World -> SPic
|
||||
worldSPic w =
|
||||
(extraShapes w, extraPics w)
|
||||
worldSPic :: Configuration -> World -> SPic
|
||||
worldSPic cfig w =
|
||||
(extraShapes w, extraPics cfig w)
|
||||
<> foldMap (dbArg _prDraw) (filtOn _pjPos _props)
|
||||
<> foldMap (($ w) . dbArg _crPict) (filtOn _crPos _creatures)
|
||||
<> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures)
|
||||
<> foldMap floorItemSPic (filtOn _flItPos _floorItems)
|
||||
<> foldMap btSPic (filtOn _btPos _buttons)
|
||||
<> foldMap mcSPic (filtOn _mcPos _machines)
|
||||
where
|
||||
filtOn f g = IM.filter (pointIsClose . f) (g w)
|
||||
pointIsClose p = dist camCen p < winSize
|
||||
winSize = 30 + max (getWindowX w) (getWindowY w)
|
||||
winSize = 30 + max (getWindowX cfig) (getWindowY cfig)
|
||||
camCen = _cameraCenter w
|
||||
|
||||
extraShapes :: World -> Shape
|
||||
extraShapes = _foregroundShape
|
||||
|
||||
extraPics :: World -> Picture
|
||||
extraPics w = pictures (_decorations w)
|
||||
extraPics :: Configuration -> World -> Picture
|
||||
extraPics cfig w = pictures (_decorations w)
|
||||
<> concatMapPic (dbArg _ptDraw) (_particles w)
|
||||
<> concatMapPic (dbArg _lsPict) (_lightSources w)
|
||||
<> testPic w
|
||||
<> concatMapPic clDraw (_clouds w )
|
||||
<> concatMapPic ppDraw (_pressPlates w )
|
||||
<> soundPics w
|
||||
<> viewBoundaries w
|
||||
<> drawPathing w
|
||||
<> soundPics cfig w
|
||||
<> viewBoundaries cfig w
|
||||
<> drawPathing cfig w
|
||||
|
||||
-- TODO remove duplicate!
|
||||
testPic :: World -> Picture
|
||||
@@ -71,13 +71,13 @@ mcSPic :: Machine -> SPic
|
||||
mcSPic bt = uncurryV translateSPf (_mcPos bt)
|
||||
$ rotateSP (_mcDir bt) (_mcDraw bt bt)
|
||||
|
||||
soundPics :: World -> Picture
|
||||
soundPics w
|
||||
| _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w
|
||||
soundPics :: Configuration -> World -> Picture
|
||||
soundPics cfig w
|
||||
| _show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w
|
||||
| otherwise = []
|
||||
|
||||
soundPic :: World -> Sound -> Picture
|
||||
soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
|
||||
soundPic :: Configuration -> World -> Sound -> Picture
|
||||
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
|
||||
where
|
||||
p = _soundPos s
|
||||
thePic
|
||||
@@ -89,9 +89,9 @@ soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
|
||||
theScale = 0.15 * f (_soundVolume s * 0.0001)
|
||||
f x = 1 - 0.5 * (1 - x)
|
||||
|
||||
drawPathing :: World -> Picture
|
||||
drawPathing w
|
||||
| _debug_pathing (_config w)
|
||||
drawPathing :: Configuration -> World -> Picture
|
||||
drawPathing cfig w
|
||||
| _debug_pathing cfig
|
||||
= -- setLayer 5 $
|
||||
(color green . pictures . map (flip thickLine 5 . tflat2) $ graphToEdges gr)
|
||||
<> concatMap dispInc (graphToIncidence gr)
|
||||
@@ -99,9 +99,9 @@ drawPathing w
|
||||
where
|
||||
dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
|
||||
gr = _pathGraph w
|
||||
viewBoundaries :: World -> Picture
|
||||
viewBoundaries w
|
||||
| _debug_view_boundaries (_config w)
|
||||
viewBoundaries :: Configuration -> World -> Picture
|
||||
viewBoundaries cfig w
|
||||
| _debug_view_boundaries cfig
|
||||
= setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
|
||||
<> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
|
||||
| otherwise = []
|
||||
|
||||
@@ -8,12 +8,13 @@ import Geometry
|
||||
import Data.List
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
wallsAndWindows
|
||||
:: World
|
||||
:: Configuration
|
||||
-> World
|
||||
-> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] )
|
||||
wallsAndWindows w
|
||||
wallsAndWindows cfig w
|
||||
= (map f wls, map f wins)
|
||||
where
|
||||
f wl = (_wlLine wl, _wlColor wl)
|
||||
(wins,wls) = partition theTest . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w
|
||||
(wins,wls) = partition theTest . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen cfig w
|
||||
theTest wl = _wlOpacity wl /= Opaque
|
||||
|
||||
|
||||
Reference in New Issue
Block a user