allow for rendering-related storage in State

this allows data collection used for rendering like the position of the
controlled object. this is used to rework the gloss rendering engine in
order to clean up various spaghetti code. introducing centered viewport
which can be toggled using 'c'.

3 files changed, 60 insertions, 23 deletions

diff --git a/README.md b/README.md
index dba0e8d..d20d5ca 100644
--- a/README.md
+++ b/README.md
@@ -10,6 +10,7 @@ the most realistic asteroids-like game in existence.
 * `down`: decrease thruster power (ship acceleration)
 * `left`: rotate ship counter-clockwise
 * `right`: rotate ship clockwise
+* `c`: toggle centered view
 
 ## roadmap
 
diff --git a/lib/Grav2ty/Control.hs b/lib/Grav2ty/Control.hs
index 13229b4..b4b7765 100644
--- a/lib/Grav2ty/Control.hs
+++ b/lib/Grav2ty/Control.hs
@@ -6,10 +6,11 @@ import Linear.V2
 import Linear.Vector
 import qualified Data.Map as Map
 
-data State a
+data State a g
   = State
-  { control :: ControlState a
-  , world   :: World a
+  { control  :: ControlState a
+  , graphics :: g
+  , world    :: World a
   } deriving (Show, Eq)
 
 data ControlState a
diff --git a/src/Main.hs b/src/Main.hs
index aebe455..2bb9ded 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -5,15 +5,27 @@ import Grav2ty.Control
 
 import Linear.V2
 import Data.Maybe
+import Data.Tuple (uncurry)
+import Debug.Trace
 import qualified Data.Map as Map
 
 import Graphics.Gloss
 import Graphics.Gloss.Data.ViewPort
 import Graphics.Gloss.Interface.Pure.Game
 
+data GlossState
+  = GlossState
+  { glossViewPort :: (Int, Int)
+  , glossViewPortCenter :: (Float, Float)
+  , glossCenterView :: Bool
+  } deriving (Show, Eq, Ord)
+
 vectorToPoint :: V2 a -> (a, a)
 vectorToPoint (V2 x y) = (x, y)
 
+tupleMap :: (a -> b) -> (a, a) -> (b, b)
+tupleMap f (a, b) = (f a, f b)
+
 renderHitbox :: Hitbox Float -> Picture
 renderHitbox box =  Color white $
   case box of
@@ -36,20 +48,28 @@ renderObjectsCenter w = accum w ([], Nothing)
         accum (w:ws) (l, c) = accum ws
           (renderObject w : l, if isLocal w then Just (vectorToPoint (objectLoc w)) else c)
 
-renderUi :: (Show a, Num a) => ControlState a -> Picture
-renderUi = translate (-350) (350) . scale 0.3 0.3 . Color green . Text . show
-  . fromMaybe 0 . fmap snd . Map.lookup LocalMod . controlInputs
+renderUi :: (Show a, Num a) => State a GlossState -> Picture
+renderUi state = (uncurry translate) (tupleMap ((+ 50) . (* (-1)) . (/ 2) . fromIntegral)
+    . glossViewPort . graphics $ state)
+  . scale 0.3 0.3 . Color green . Text . show
+  . fromMaybe 0 . fmap snd . Map.lookup LocalMod . controlInputs . control $ state
+
+renderStars :: (Float, Float) -> Picture
+renderStars center = undefined
 
-renderWorld :: State Float -> Picture
-renderWorld (State ps world) = Pictures [renderUi ps, centeredWorld]
-  where (objs, center) = renderObjectsCenter world
-        centeredWorld  = applyViewPortToPicture viewport $ Pictures objs
-        viewport       = ViewPort (invert . fromMaybe (0, 0) $ center) 0 1
-        invert (x, y)  = (-x, -y)
+renderGame :: State Float GlossState -> Picture
+renderGame state = Pictures [ renderUi  state
+                            , if centeredView then centeredWorld else objs ]
+  where objs = Pictures . map renderObject . world $ state
+        centeredWorld = applyViewPortToPicture viewport objs
+        centeredView = glossCenterView . graphics $ state
+        viewport = ViewPort (invert . glossViewPortCenter . graphics $ state) 0 1
+        invert (x, y) = (-x, -y)
 
-eventHandler :: Floating a => Event -> State a -> State a
+eventHandler :: Floating a => Event -> State a GlossState -> State a GlossState
 eventHandler (EventKey key Down _ _) state = state
   { control = ControlState . Map.alter f LocalMod . controlInputs . control $ state
+  , graphics = (graphics state) { glossCenterView = centerView }
   }
     where f = Just . f' . fromMaybe (0, 0)
           f' = case key of
@@ -58,17 +78,32 @@ eventHandler (EventKey key Down _ _) state = state
                 SpecialKey KeyLeft -> \(rot, acc) -> (rot + 0.1, acc)
                 SpecialKey KeyRight -> \(rot, acc) -> (rot - 0.1, acc)
                 _                   -> id
+          centerView = (if key == (Char 'c') then not else id)
+            . glossCenterView . graphics $ state
+eventHandler (EventResize vp) state = state
+  { graphics = (graphics state) { glossViewPort = vp } }
 eventHandler _ s = s
 
-updateWorld :: Float -> State Float -> State Float
-updateWorld timeStep (State ctrl world) = State ctrl $ map
-  (\obj ->
-    updateObject timeStep (gravitationForces world obj) .
-      applyControls ctrl $ obj)
-  world
+updateWorld :: Float -> State Float GlossState -> State Float GlossState
+updateWorld timeStep (State ctrl g world) = State ctrl
+  (g { glossViewPortCenter = fromMaybe (0, 0) center }) newWorld
+  where (newWorld, center) = updateAndExtract world extractCenter ([], Nothing)
+        extractCenter :: Object Float -> Maybe (Float, Float)
+                      -> Maybe (Float, Float)
+        extractCenter o@(Dynamic { objectMod = LocalMod }) _ =
+          Just . vectorToPoint . objectLoc $ o
+        extractCenter _ c = c
+        updateAndExtract :: World Float -> (Object Float -> i -> i)
+                         -> (World Float, i) -> (World Float, i)
+        updateAndExtract [] f acc = acc
+        updateAndExtract (x:xs) f (xs', i) = updateAndExtract xs f
+          (updateObject' x : xs', f x i)
+        updateObject' :: Object Float -> Object Float
+        updateObject' obj = updateObject timeStep (gravitationForces world obj)
+          . applyControls ctrl $ obj
 
-initialWorld :: Fractional a => State a
-initialWorld = State (ControlState Map.empty)
+initialWorld :: Fractional a => State a GlossState
+initialWorld = State (ControlState Map.empty) (GlossState (800, 800) (0, 0) True)
   [ Dynamic shipHitbox 0 10000 (V2 200 0) (V2 0 0) (V2 0 0) LocalMod
   , Static (centeredCircle 80) 0 moonMass (V2 0 0)
 --  , Static (centeredCircle 40) 0 (0.5 * moonMass) (V2 250 120)
@@ -77,10 +112,10 @@ initialWorld = State (ControlState Map.empty)
 
 main :: IO ()
 main = play
-  (InWindow "grav2ty" (800, 800) (0,0))
+  (InWindow "grav2ty" (glossViewPort . graphics $ initialWorld) (0,0))
   black
   300
   initialWorld
-  renderWorld
+  renderGame
   eventHandler
   updateWorld