87 lines
2.5 KiB
Haskell
87 lines
2.5 KiB
Haskell
module Dodge.Render.Picture (
|
|
fixedCoordPictures,
|
|
) where
|
|
|
|
import Control.Lens
|
|
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
|
|
<> customMouseCursor u
|
|
<> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u))
|
|
<> displayFrameTicks u
|
|
where
|
|
cfig = _uvConfig u
|
|
|
|
displayFrameTicks :: Universe -> Picture
|
|
displayFrameTicks u =
|
|
if debugOn Show_ms_frame $ _uvConfig u
|
|
then
|
|
setDepth (-1)
|
|
. translate (-10) (- halfHeight (_uvConfig u) + 6)
|
|
. scale 0.2 0.2
|
|
$ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
|
|
else 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 =
|
|
stackPicturesAt
|
|
(halfWidth cfig)
|
|
(windowYFloat cfig - 50)
|
|
cfig
|
|
(map (centerText . f) $ u ^.. uvSideEffects . each)
|
|
where
|
|
cfig = _uvConfig u
|
|
f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
|
|
f x = _ceString x ++ " QUEUED"
|
|
|
|
customMouseCursor :: Universe -> Picture
|
|
customMouseCursor u =
|
|
uncurryV translate (u ^. uvWorld . input . mousePos)
|
|
. color white
|
|
$ mouseCursorType u
|
|
|
|
mouseCursorType :: Universe -> Picture
|
|
mouseCursorType u
|
|
| null (u ^. uvScreenLayers) = rotate a (drawPlus 5)
|
|
| otherwise = mousePlus
|
|
where
|
|
w = u ^. uvWorld
|
|
a = fromMaybe 0 $ do
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
|
return . toClosestMultiple (pi / 32) $
|
|
argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos)
|
|
- w ^. cWorld . cwCamPos . camRot
|
|
|
|
mousePlus :: Picture
|
|
mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
|
|
|
|
drawPlus :: Float -> Picture
|
|
drawPlus x = pictures [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
|