158 lines
5.1 KiB
Haskell
158 lines
5.1 KiB
Haskell
module Dodge.Render.Picture (
|
|
fixedCoordPictures,
|
|
) where
|
|
|
|
import Dodge.CharacterEnums
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.Base.Coordinate
|
|
import Dodge.Base.Window
|
|
import Dodge.Data.Universe
|
|
import Dodge.Render.HUD
|
|
import Dodge.Render.List
|
|
import Dodge.Render.MenuScreen
|
|
import Geometry
|
|
import HelpNum
|
|
import Picture
|
|
|
|
fixedCoordPictures :: Universe -> Picture
|
|
fixedCoordPictures u =
|
|
drawMenuOrHUD cfig u
|
|
<> drawConcurrentMessage u
|
|
<> drawMouseCursor u
|
|
<> ttl (translate hw 0 $ drawList (map text (_uvTestString u u)))
|
|
<> ttl
|
|
( translate (0.5 * hw) (- hh)
|
|
. drawList
|
|
. map text
|
|
$ show (u ^. uvWorld . cWorld . lWorld . lTestInt) :
|
|
(u ^. uvWorld . cWorld . lWorld . lTestString)
|
|
)
|
|
<> displayFrameTicks u
|
|
<> aimDelaySweep (u ^. uvWorld)
|
|
where
|
|
cfig = _uvConfig u
|
|
hw = halfWidth cfig
|
|
hh = halfHeight cfig
|
|
ttl = toTopLeft cfig
|
|
|
|
displayFrameTicks :: Universe -> Picture
|
|
displayFrameTicks u
|
|
| debugOn Show_ms_frame $ _uvConfig u =
|
|
translate (-10) (- halfHeight (_uvConfig u) + 6)
|
|
. scale 0.2 0.2
|
|
$ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
|
|
| otherwise = mempty
|
|
|
|
fpsText :: (Show a, Ord a, Num a) => a -> Picture
|
|
fpsText x = color col . text $ "ms/frame " ++ show x
|
|
where
|
|
col
|
|
| x < 22 = blue
|
|
| x < 30 = green
|
|
| x < 40 = yellow
|
|
| x < 50 = orange
|
|
| otherwise = red
|
|
|
|
drawMenuOrHUD :: Configuration -> Universe -> Picture
|
|
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
|
|
[] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
|
|
(lay : _) -> drawMenuScreen cfig lay
|
|
|
|
drawConcurrentMessage :: Universe -> Picture
|
|
drawConcurrentMessage u =
|
|
translate 0 (50 - halfHeight cfig)
|
|
. stackPicturesAt
|
|
. map (centerText . f)
|
|
$ u ^.. uvSideEffects . each
|
|
where
|
|
cfig = _uvConfig u
|
|
f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
|
|
f x = _ceString x ++ " QUEUED"
|
|
|
|
drawMouseCursor :: Universe -> Picture
|
|
drawMouseCursor u =
|
|
uncurryV translate (u ^. uvWorld . input . mousePos)
|
|
. color white
|
|
$ mouseCursorType u
|
|
|
|
mouseCursorType :: Universe -> Picture
|
|
mouseCursorType u
|
|
| isselect = drawPlus 5
|
|
| Just tmid <- u ^? uvWorld . hud . hudElement . subInventory . termID = determineTermCursor tmid u
|
|
| Just csel <- u ^? uvWorld . hud . hudElement . subInventory . ciSelection =
|
|
if ( csel == u ^? uvWorld . input . mouseContext . mcoCombInv
|
|
|| null (u ^? uvWorld . input . mouseContext . mcoCombInv)
|
|
)
|
|
&& null (u ^? uvWorld . input . mouseContext . mcoInv)
|
|
&& fmap fst csel /= Just (-1)
|
|
&& fromMaybe True (u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix 0 . ssItems . ix 0 . siIsSelectable) --HACK to check there is something creatable
|
|
then drawGapPlus 5
|
|
else drawPlus 5
|
|
| otherwise = rotate a (drawPlus 5)
|
|
where
|
|
isselect =
|
|
not (null $ u ^. uvScreenLayers)
|
|
|| not (null $ u ^? uvWorld . input . mouseContext . mcoInv)
|
|
w = u ^. uvWorld
|
|
a = fromMaybe 0 $ do
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
|
return . toClosestMultiple (pi / 32) $
|
|
argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
|
|
- w ^. wCam . camRot
|
|
|
|
determineTermCursor :: Int -> Universe -> Picture
|
|
determineTermCursor tmid u = fromMaybe (drawPlus 5) $ do
|
|
return drawReturn
|
|
|
|
drawReturn :: Picture
|
|
drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]
|
|
|
|
drawWireRectCursor :: Picture
|
|
drawWireRectCursor = scale 0.1 0.1 $ text [cWireRect]
|
|
--drawReturn = text "ASDF"
|
|
|
|
drawPlus :: Float -> Picture
|
|
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
|
|
|
|
--drawDoublePlus :: Float -> Picture
|
|
--drawDoublePlus x = fold [line [V2 (- (1.5*x)) 0, V2 (1.5*x) 0]
|
|
-- , line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
|
|
-- , line [V2 (negate 0.5 * x) (- x), V2 (negate 0.5 * x) x]
|
|
-- ]
|
|
|
|
drawGapPlus :: Float -> Picture
|
|
drawGapPlus x =
|
|
fold
|
|
[ line [V2 (-1.5 * x) 0, V2 (-0.5 * x) 0]
|
|
, line [V2 (0.5 * x) 0, V2 (1.5 * x) 0]
|
|
, line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
|
|
, line [V2 (-0.5 * x) (- x), V2 (-0.5 * x) x]
|
|
]
|
|
|
|
aimDelaySweep :: World -> Picture
|
|
aimDelaySweep w = fromMaybe mempty $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
aimstatus <- cr ^? crStance . posture
|
|
guard (aimstatus == Aiming)
|
|
return $ drawSweep cr w
|
|
|
|
drawSweep :: Creature -> World -> Picture
|
|
drawSweep cr w = fromMaybe mempty $ do
|
|
a <- safeArgV (mwp -.- p)
|
|
let a'
|
|
| a - cdir > pi = cdir + 2 * pi
|
|
| a - cdir < - pi = cdir - 2 * pi
|
|
| otherwise = cdir
|
|
return $
|
|
uncurryV translate (worldPosToScreen campos p) $
|
|
arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
|
|
where
|
|
cdir = _crDir cr
|
|
rot = campos ^. camRot
|
|
p = _crPos cr
|
|
campos = w ^. wCam
|
|
theinput = w ^. input
|
|
mwp = mouseWorldPos theinput campos
|