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

Move main to allow for new executables

Browse Source
This commit is contained in:
justin
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+19 -18
View File
@@ -56,7 +56,7 @@ cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of
where
hh = halfHeight w
hw = halfWidth w
sp = (V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)))
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
topInvCursor :: Color -> Int -> World -> [Picture]
topInvCursor col iPos w
@@ -97,7 +97,7 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
displayMidList :: World -> [String] -> String -> [Picture]
displayMidList w strs s =
invHead w s
++ renderListAt (V2 (150) (-60)) (map (,white) strs) w
++ renderListAt (V2 150 (-60)) (map (,white) strs) w
invHead :: World -> String -> [Picture]
invHead w s = [winScale w . translate (-130) (halfHeight w - 40)
@@ -145,17 +145,17 @@ drawLocations wrld = displayListTopLeft locs wrld
displayListCoords :: World -> [Point2]
displayListCoords w = map (g . f) [(1::Int)..]
where
f i = (V2 ( 15 - halfWidth w ) ( halfHeight w - (20 * fromIntegral i)) )
g (V2 x y) = (V2 (2*x / getWindowX w) ( 2*y / getWindowY w))
f i = V2 ( 15 - halfWidth w ) ( halfHeight w - (20 * fromIntegral i))
g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w)
displayListEndCoords :: World -> [String] -> [Point2]
displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..]
where
f :: Int -> Point2
f i = (V2 ( 15 - halfWidth w ) ( 2.5 + halfHeight w - (20 * fromIntegral i)) )
g (V2 x y) = (V2 (2*x / getWindowX w) ( 2*y / getWindowY w))
f i = V2 ( 15 - halfWidth w ) ( 2.5 + halfHeight w - (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))
h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
--bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
@@ -202,7 +202,7 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
objPos obj = case obj of Left flit -> _flItPos flit
Right bt -> _btPos bt
mayScreenPos = mayObj >>= (\theObj -> Just (worldPosToScreen w $ objPos theObj))
sc (V2 x y) = (V2 (x*2/getWindowX w) ( y*2/getWindowY w))
sc (V2 x y) = V2 (x*2/getWindowX w) ( y*2/getWindowY w)
maybeLine = do
itScreenPos <- mayScreenPos
theText <- fmap (snd . colAndText) mayObj
@@ -212,11 +212,12 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
let p' = V2 ( pushout - halfWidth w + 130)
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
return $ flip thickLineCol (1 / halfWidth w)
return $ thickLineCol
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
(1 / halfWidth w)
{- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures
@@ -238,10 +239,10 @@ openCursorAt
openCursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
$ lineCol
[((V2 wth 12.5) ,withAlpha 0 col)
,((V2 0 12.5) ,col)
,((V2 ( 0) (-7.5)) ,col)
,((V2 ( wth) (-7.5)) ,withAlpha 0 col)
[(V2 wth 12.5 ,withAlpha 0 col)
,(V2 0 12.5 ,col)
,(V2 0 (-7.5),col)
,(V2 wth (-7.5),withAlpha 0 col)
]
cursorAt
:: Float -- ^ Width
@@ -255,11 +256,11 @@ cursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
. color col
$ line
[(V2 wth 12.5)
,(V2 0 12.5)
,(V2 ( 0) (-7.5))
,(V2 ( wth) (-7.5))
,(V2 wth 12.5)
[V2 wth 12.5
,V2 0 12.5
,V2 0 (-7.5)
,V2 wth (-7.5)
,V2 wth 12.5
]
displayHP :: Int -> World -> Picture
src/Dodge/Render/Picture.hs
+4 -4
View File
@@ -22,10 +22,10 @@ import qualified Data.IntMap.Lazy as IM
worldPictures :: World -> Picture
worldPictures w = concat $
(IM.elems $ _decorations w) ++
IM.elems (_decorations w) ++
(map (dbArg _pjDraw) . IM.elems $ _projectiles w) ++
(map (crDraw w) . IM.elems $ _creatures w) ++
(map (dbArg _ptDraw) $ _particles w) ++
map (dbArg _ptDraw) (_particles w) ++
[ testPic w
, concatMap drawItem . IM.elems $ _floorItems w
, concatMap (crDraw w) . IM.elems $ _creatures w
@@ -53,7 +53,7 @@ customMouseCursor w =
scale (2 /getWindowX w) (2/ getWindowY w)
. uncurryV translate (_mousePos w)
. color white
$ pictures [ line [(V2 (-5) (0)),(V2 5 0)] , line [(V2 (0) (-5)),(V2 0 5)] ]
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
testPic :: World -> Picture
testPic _ = blank
@@ -213,7 +213,7 @@ wallsAndWindows w
(wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w
wallsToList :: [((Point2,Point2),Point4)] -> [Float]
wallsToList = concatMap (\(((V2 a b),(V2 c d)),(V4 e f g h)) -> [a,b,c,d,e,f,g,h])
wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h])
lightsForGloom :: World -> [(Point3,Float,Float)]