justin
2c6037d852
There is still a further choice/improvement to be made here, but at least dragging shouldn't glitch out as it currently stands
257 lines
7.2 KiB
Haskell
257 lines
7.2 KiB
Haskell
module Dodge.Render.Picture (
|
|
fixedCoordPictures,
|
|
) where
|
|
|
|
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
|
|
<> 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)
|
|
<> drawMouseCursor u
|
|
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 (u ^? uvWorld . input . mouseContext . mcoMenuClick) 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
|
|
. 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 0 _ -> drawDragDrop 5
|
|
OverInvDrag 3 (Just (3,_)) _ _ -> drawDrag 5
|
|
OverInvDrag 3 _ _ _ -> drawDragPickup 5
|
|
OverInvDrag {} -> drawEmptySet 5
|
|
OverInvDragSelect {} -> drawDragSelect 5
|
|
OverInvSelect {} -> drawSelect 5
|
|
OverInvFilt {} -> drawCombFilter 5
|
|
OverCombSelect {} -> drawSelect 5
|
|
OverCombFilter {} -> drawCombFilterJump 5
|
|
OverCombCombine {} -> drawGapPlus 5
|
|
OverCombEscape -> rotate (pi/4) $ drawPlus 5
|
|
OverTerminalReturn {} -> drawReturn 5
|
|
OverTerminalEscape -> rotate (pi/4) $ drawPlus 5
|
|
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 ^. wCam) -.- cpos)
|
|
- w ^. wCam . camRot
|
|
|
|
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
|
|
drawCombFilterJump :: Float -> Picture
|
|
drawCombFilterJump 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
|
|
|
|
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 :: World -> Picture
|
|
aimDelaySweep w = fold $ 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
|