Move main to allow for new executables

This commit is contained in:
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
+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