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

Cleanup warnings

Browse Source
This commit is contained in:
justin
2021-05-17 22:39:18 +02:00
parent d7fcdbf550
commit 69f915a894
102 changed files with 1243 additions and 1185 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+12 -14
View File
@@ -1,16 +1,13 @@
module Dodge.Render.HUD
where
import Dodge.Data
import Dodge.Base
import Dodge.Inventory
import Picture
import Geometry
import Data.Maybe
import qualified Data.IntMap as IM
import Control.Lens
hudDrawings :: World -> Picture
@@ -40,7 +37,7 @@ displayListTopLeft :: [(String,Color)] -> World -> [Picture]
displayListTopLeft scols w =
map scaler $ zipWith
(translate (15-halfWidth w))
( map (\x -> halfHeight w - (20 * (fromIntegral x+1))) [0..] )
( map (\x -> halfHeight w - (20 * (fromIntegral x+1))) ([0..]::[Int]) )
( map (\(s,col) -> scale 0.1 0.1 . dShadCol col $ text s) scols )
where
scaler = scale (2 / getWindowX w) (2 / getWindowY w)
@@ -55,15 +52,15 @@ itemStringCol NoItem = ("----", greyN 0.5)
itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm)
drawLocations :: World -> [Picture]
drawLocations w = displayListTopLeft locs w
++ zipWith bFunc (displayListEndCoords w locTexts) locPoss
++ mapOverlay w
++ [drawListCursor white iPos w]
drawLocations wrld = displayListTopLeft locs wrld
++ zipWith bFunc (displayListEndCoords wrld locTexts) locPoss
++ mapOverlay wrld
++ [drawListCursor white iPos wrld]
where
iPos = _selLocation w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
zoom = _carteZoom w
iPos = _selLocation wrld
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
--cZoom = _carteZoom w
locTexts = map fst locs
bFunc (x,y) (z,w) = pictures
[ bezierQuad (withAlpha 0.0 white) (withAlpha 0.2 white) 0.050 0.010 (x,y) (0,y) (z,w)
@@ -72,7 +69,7 @@ drawLocations w = displayListTopLeft locs w
] --cheapo antialiasing
displayListCoords :: World -> [Point2]
displayListCoords w = map (g . f) [1..]
displayListCoords w = map (g . f) [(1::Int)..]
where
f i = ( 15 - halfWidth w , halfHeight w - (20 * fromIntegral i) )
g (x,y) = (2*x / getWindowX w, 2*y / getWindowY w)
@@ -106,7 +103,7 @@ mapWall w wl =
{- | Pictures of popup text for items close to your position.-}
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $ zipWith renderList [0..] (map colAndText $ _closeActiveObjects w)
closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText $ _closeActiveObjects w)
++ maybeToList maybeLine
where
colAndText (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
@@ -126,6 +123,7 @@ closeObjectTexts w = pictures $ zipWith renderList [0..] (map colAndText $ _clos
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 140
xtran :: Int -> Float
xtran 0 = case mayIt of Nothing -> 25
_ -> -25
xtran _ = 0
src/Dodge/Render/MenuScreen.hs
+4 -4
View File
@@ -6,9 +6,9 @@ module Dodge.Render.MenuScreen
)
where
import Dodge.Data.Menu
import Dodge.Config.Update
--import Dodge.Config.Update
import Dodge.Config.Data
import Dodge.Base (halfWidth,halfHeight)
--import Dodge.Base (halfWidth,halfHeight)
import Picture
menuScreen
@@ -18,7 +18,6 @@ menuScreen
-> [MenuLayer]
-> Picture
menuScreen cfig hw hh mLays = case mLays of
[] -> blank
(LevelMenu x:_) -> optionsList hw hh ("LEVEL"++show x) []
(PauseMenu:_) -> optionsList hw hh "PAUSED"
["N - NEW LEVEL"
@@ -57,7 +56,7 @@ menuScreen cfig hw hh mLays = case mLays of
mavol = f $ _volume_master cfig
snvol = f $ _volume_sound cfig
muvol = f $ _volume_music cfig
f x = show $ round $ 10 * x
f x = show $ (round $ 10 * x :: Int)
showShadRes i = "1/"++ show i
optionsList
@@ -74,6 +73,7 @@ optionsList hw hh tit ops = pictures $
where
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
controlsList :: Picture
controlsList = pictures $ concat $ zipWith butAndEff
[("wasd", "movement")
,("[rmb]", "aim")
src/Dodge/Render/Picture.hs
+13 -13
View File
@@ -64,7 +64,7 @@ clDraw c = uncurry translate (_clPos c) (_clPict c c)
wallFloorsToDraw :: World -> [Wall]
wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
where
onScreen wall = lineOnScreen w ((\(a,b) -> [a,b]) $ _wlLine wall)
onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall
isVisible wl
| wl ^? blVisible == Just False = False
| otherwise = onScreen wl
@@ -98,12 +98,12 @@ outsideScreenPolygon w = [tr,tl,bl,br]
where
scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter w
tr = scTran $ scRot $ scZoom ( 3*halfWidth w , 3* halfHeight w)
tl = scTran $ scRot $ scZoom (- (3*halfWidth w), 3* halfHeight w)
br = scTran $ scRot $ scZoom ( 3*halfWidth w ,- (3* halfHeight w))
bl = scTran $ scRot $ scZoom (- (3*halfWidth w),- (3* halfHeight w))
x = halfWidth w + halfHeight w
wallShadowsToDraw :: World -> [Wall]
wallShadowsToDraw w = filter (fromMaybe True . (^? blVisible))
@@ -112,8 +112,8 @@ wallShadowsToDraw w = filter (fromMaybe True . (^? blVisible))
-- cannot only test if walls are on screen, but also if they are on the cone
-- towards the center of sight
lineOnScreenCone :: World -> [Point2] -> Bool
lineOnScreenCone w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp
lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp
|| any (isJust . uncurry (intersectSegSeg' p1 p2)) sps
where
sp' = screenPolygon w
@@ -123,8 +123,8 @@ lineOnScreenCone w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygo
sps = zip sp (tail sp ++ [head sp])
lineOnScreen :: World -> [Point2] -> Bool
lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp
lineOnScreen :: World -> Point2 -> Point2 -> Bool
lineOnScreen w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp
|| any (isJust . uncurry (intersectSegSeg' p1 p2)) sps
where
sp = screenPolygon w
@@ -156,17 +156,19 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] +
wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' y ((2*.*y) -.- x))
. makeLoopPairs $ screenPolygon w
rectangleSolid :: Float -> Float -> Picture
rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
drawItem :: FloorItem -> Picture
drawItem flIt = uncurry translate (_flItPos flIt)
$ rotate (_flItRot flIt) (_itFloorPict (_flIt flIt))
drawItem flit = uncurry translate (_flItPos flit)
$ rotate (_flItRot flit) (_itFloorPict (_flIt flit))
ffToDraw :: World -> [ForceField]
ffToDraw w = filter (lineOnScreen w . _ffLine) $
IM.elems $ over ffLine (map ( -.- _cameraCenter w)) <$>
_forceFields w
ffToDraw _ = []
-- filter (lineOnScreen w . _ffLine) $
-- IM.elems $ over ffLine (map ( -.- _cameraCenter w)) <$>
-- _forceFields w
drawFF :: ForceField -> Picture
drawFF FF{_ffLine = l, _ffColor = col} = pictures
@@ -179,14 +181,12 @@ drawFFShadow w ff
| youOnFF = []
| otherwise = map (rotate ( _cameraRot w) . pane) [0,0.05..0.25]
where
p = rotateV (-_cameraRot w) ypShift
x = rotateV (-_cameraRot w) x'
y = rotateV (-_cameraRot w) y'
yp = _crPos $ you w
(x1:y1:_) = _ffLine ff
(x':y':_) | isRHS x1 y1 yp = [y1,x1]
| otherwise = [x1,y1]
fCol = color (_ffColor ff)
col = _ffColor ff
ypShift = yp -.- _cameraCenter w
youOnFF = circOnSeg x' y' ypShift (_crRad $ you w)