307 lines
8.8 KiB
Haskell
307 lines
8.8 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
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 =
|
|
aimDelaySweep u
|
|
<> drawMenuOrHUD cfig u
|
|
<> drawConcurrentMessage u
|
|
<> ttl (translate (hw - 100) 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
|
|
<> drawMouseCursor u
|
|
<> ( toTopLeft cfig . translate (1.3 * halfWidth cfig) 0
|
|
. drawList
|
|
. take 50
|
|
. drop (u ^. uvDebugMessageOffset)
|
|
. map text
|
|
$ foldMap (`_debugMessage` u) (_uvDebug u) -- other debug pics in extraPics
|
|
)
|
|
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)
|
|
(x : _) -> drawMenuScreen cfig (u ^? uvWorld . input . mouseContext . mcoMenuClick) x
|
|
|
|
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
|
|
. setDepth 1
|
|
$ mouseCursorType u
|
|
|
|
mouseCursorType :: Universe -> Picture
|
|
mouseCursorType u = case u ^. uvWorld . input . mouseContext of
|
|
NoMouseContext -> drawEmptySet 5
|
|
MouseAiming -> rotate a (drawPlus 5)
|
|
MouseMenuClick{} -> drawMenuClick 5
|
|
MouseMenuCursor -> drawMenuCursor 5
|
|
MouseInGame -> drawPlus 5
|
|
OverInvDrag 0 (Just (3, _)) _ _ -> drawDragDrop 5
|
|
OverInvDrag 0 Nothing _ _ -> drawDragDrop 5
|
|
OverInvDrag 0 (Just (0, _)) _ _ -> drawDrag 5
|
|
OverInvDrag 0 _ _ _ -> drawEmptySet 5
|
|
OverInvDrag 3 (Just (3, _)) _ _ -> drawDrag 5
|
|
OverInvDrag 3 (Just (0, _)) _ _ -> drawDragPickup 5
|
|
OverInvDrag 3 (Just (1, _)) _ _ -> drawDragPickup 5
|
|
OverInvDrag 3 Nothing _ _ -> drawDragPickup 5
|
|
OverInvDrag 3 _ _ _ -> drawEmptySet 5
|
|
OverInvDrag{} -> drawEmptySet 5
|
|
OverInvDragSelect{} -> drawDragSelect 5
|
|
OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
|
|
OverInvSelect (2, _) | selsec == Just 2 -> drawJumpDown 5
|
|
OverInvSelect{} -> drawSelect 5
|
|
OverCombFiltInv{} -> drawCombFilter 5
|
|
OverCombSelect{} -> drawSelect 5
|
|
OverCombFilter{} -> drawJumpDown 5
|
|
OverCombCombine{} -> drawGapPlus 5
|
|
OverCombEscape -> rotate (pi / 4) $ drawPlus 5
|
|
OverTerminal _ ts -> drawCursorByTerminalStatus ts
|
|
OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
|
|
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
|
|
where
|
|
w = u ^. uvWorld
|
|
selsec = u ^? uvWorld . hud . hudElement . diSelection . _Just . _1
|
|
a = fromMaybe 0 $ do
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
|
return . toClosestMultiple (pi / 32) $
|
|
argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
|
|
- w ^. wCam . camRot
|
|
|
|
drawCursorByTerminalStatus :: TerminalStatus -> Picture
|
|
drawCursorByTerminalStatus = \case
|
|
TerminalPressTo "QUIT" -> drawQuitTerminal 5
|
|
TerminalPressTo _ -> drawArrowDown 5
|
|
TerminalTextInput "QUIT" -> drawQuitTerminal 5
|
|
TerminalTextInput{} -> drawReturn 5
|
|
_ -> drawEmptySet 5
|
|
|
|
drawQuitTerminal :: Float -> Picture
|
|
drawQuitTerminal x = fold
|
|
[ line [V2 x x, V2 (- x) (- x)]
|
|
, line [V2 x (-x), V2 (- x) x]
|
|
, polygonWire (square x)
|
|
]
|
|
|
|
drawEmptySet :: Float -> Picture
|
|
drawEmptySet x =
|
|
fold
|
|
[ line [V2 x x, V2 (- x) (- x)]
|
|
, circle x
|
|
]
|
|
|
|
drawReturn :: Float -> Picture
|
|
drawReturn x =
|
|
fold
|
|
[ line [V2 0 0, V2 y y]
|
|
, line [V2 0 0, V2 y (- y)]
|
|
, line [V2 0 0, V2 (2 * y) 0]
|
|
, line [V2 (2 * y) 0, V2 (2 * y) (2 * x)]
|
|
]
|
|
where
|
|
y = 0.7 * x
|
|
|
|
--drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]
|
|
|
|
drawPlus :: Float -> Picture
|
|
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
|
|
|
|
drawMenuClick :: Float -> Picture
|
|
drawMenuClick z =
|
|
fold
|
|
[ line [V2 y 0, V2 x 0]
|
|
, line [V2 ny 0, V2 nx 0]
|
|
, line [V2 0 ny, V2 0 nx]
|
|
, line [V2 0 y, V2 0 x]
|
|
]
|
|
where
|
|
x = 0.5 * z
|
|
y = x + z
|
|
ny = - y
|
|
nx = - x
|
|
|
|
drawMenuCursor :: Float -> Picture
|
|
drawMenuCursor z =
|
|
fold
|
|
[ line [V2 y 0, V2 x 0]
|
|
, line [V2 ny 0, V2 nx 0]
|
|
, line [V2 0 ny, V2 0 nx]
|
|
, line [V2 0 y, V2 0 x]
|
|
]
|
|
where
|
|
x = z
|
|
y = x + z
|
|
ny = - y
|
|
nx = - x
|
|
|
|
drawJumpDown :: Float -> Picture
|
|
drawJumpDown x =
|
|
rotate (0.25 * pi) $
|
|
fold [line [V2 0 0, V2 x 0], line [V2 0 0, V2 0 x]]
|
|
|
|
drawDragSelect :: Float -> Picture
|
|
drawDragSelect x = polygonWire $ rectWH (0.5 * x) x
|
|
|
|
drawDrag :: Float -> Picture
|
|
drawDrag x =
|
|
line [V2 0 y, V2 0 z]
|
|
<> line [V2 0 (- y), V2 0 (- z)]
|
|
<> line [V2 (- w) (z - w), V2 0 z, V2 w (z - w)]
|
|
<> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
|
|
<> drawSelect 5
|
|
where
|
|
z = 1.5 * x
|
|
y = 0.5 * x
|
|
w = 0.3 * x
|
|
|
|
drawVerticalDoubleArrow :: Float -> Picture
|
|
drawVerticalDoubleArrow x =
|
|
line [V2 0 z, V2 0 (- z)]
|
|
<> line [V2 (- w) (z - w), V2 0 z, V2 w (z - w)]
|
|
<> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
|
|
where
|
|
z = 1.5 * x
|
|
w = 0.6 * x
|
|
|
|
drawArrowDown :: Float -> Picture
|
|
drawArrowDown x =
|
|
line [V2 0 z, V2 0 (- z)]
|
|
<> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
|
|
where
|
|
z = 1 * x
|
|
w = 0.6 * x
|
|
|
|
drawDragDrop :: Float -> Picture
|
|
drawDragDrop x =
|
|
line (fmap (+ V2 z (- x)) [V2 (- x) x, V2 0 x, V2 0 (- x)])
|
|
<> line (fmap (+ V2 z (- x)) [V2 (- y) (y - x), V2 0 (- x), V2 y (y - x)])
|
|
<> drawSelect 5
|
|
where
|
|
z = 1.5 * x
|
|
y = 0.7 * x
|
|
|
|
drawDragPickup :: Float -> Picture
|
|
drawDragPickup x =
|
|
line [V2 (-0.5 * x) 0, V2 (- z) 0, V2 (- z) z]
|
|
<> line [V2 (- (z + y)) (z - y), V2 (- z) z, V2 (y - z) (z - y)]
|
|
<> drawSelect 5
|
|
where
|
|
z = 1.5 * x
|
|
y = 0.7 * x
|
|
|
|
--drawFiltDrag :: Float -> Picture
|
|
--drawFiltDrag x = polygonWire
|
|
-- [ V2 0 y
|
|
-- , V2 x y
|
|
-- , V2 0 (-y)
|
|
-- , V2 (-x) (-y)
|
|
-- ]
|
|
-- where
|
|
-- y = 0.5 * x
|
|
|
|
drawSelect :: Float -> Picture
|
|
drawSelect x = polygonWire $ rectWH (0.5 * x) (0.5 * x)
|
|
|
|
-- line [V2 (-x) 0, V2 0 0]
|
|
--drawSelect x = line
|
|
-- [ V2 x x
|
|
-- , V2 0 x
|
|
-- , V2 0 (-x)
|
|
-- , V2 x (-x)
|
|
-- ] <>
|
|
-- line [V2 (-x) 0, V2 0 0]
|
|
|
|
drawCombFilter :: Float -> Picture
|
|
drawCombFilter x =
|
|
rotate (0.25 * pi) $
|
|
fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 0]]
|
|
|
|
--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 :: Universe -> Picture
|
|
aimDelaySweep u = fold $ do
|
|
let w = u ^. uvWorld
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
Aiming{} <- cr ^? crStance . posture
|
|
return $ drawAimSweep cr w
|
|
|
|
drawAimSweep :: Creature -> World -> Picture
|
|
drawAimSweep cr w = fold $ do
|
|
a <- safeArgV (mwp -.- p)
|
|
return $
|
|
uncurryV translate (worldPosToScreen campos p) $
|
|
arcFull (a - rot) 10 white (a + diffAngles cdir a - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
|
|
where
|
|
cdir = _crDir cr
|
|
rot = campos ^. camRot
|
|
p = _crPos cr
|
|
campos = w ^. wCam
|
|
mwp = w ^. cWorld . lWorld . lAimPos
|