smaller aesthetics

src/Main.hs

@@ -6,11 +6,14 @@ import Affection as A
 import qualified SDL
 
 import NanoVG hiding (V2(..), V3(..))
+import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)
 
 import Linear
 
 import Foreign.C.Types (CInt(..))
 
+import Data.Maybe (fromJust)
+
 -- internal imports
 
 import Types
@@ -38,7 +41,7 @@ main = do
         , updateLoop     = update
         , drawLoop       = draw
         , loadState      = Init.init
-        , cleanUp        = const (return ())
+        , cleanUp        = clean
         , initScreenMode = SDL.Windowed
         }
   withAffection config
@@ -81,3 +84,7 @@ exitOnWindowClose (MsgWindowClose _ _) = do
   liftIO $ logIO A.Debug "Window Closed"
   quit
 exitOnWindowClose _ = return ()
+
+clean :: UserData -> IO ()
+clean ud = do
+  SDL.glDeleteContext $ fromJust $ threadContext ud

src/NPC.hs

@@ -10,7 +10,7 @@ import Data.List (find)
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Concurrent.MVar
-import Control.Concurrent (forkOS)
+import Control.Concurrent (forkIO)
 
 import Linear
 
@@ -118,19 +118,19 @@ updateNPCs
   -> SystemT Entity m ()
 updateNPCs imgmat rp dt =
   emap allEnts $ do
-    with npcState
+    with npcMoveState
     with vel
     with pos
     with rot
     with anim
-    npcState' <- query npcState
+    npcState' <- query npcMoveState
     case npcState' of
       NPCStanding ttl future -> do
         let nttl = ttl - dt
         if nttl > 0
         then
           return $ unchanged
-            { npcState = Set $ NPCStanding nttl future
+            { npcMoveState = Set $ NPCStanding nttl future
             , vel      = Set $ V2 0 0
             }
         else do
@@ -138,11 +138,11 @@ updateNPCs imgmat rp dt =
           case mpath of
             Just path ->
               return $ unchanged
-                { npcState = Set $ NPCWalking path
+                { npcMoveState = Set $ NPCWalking path
                 }
             Nothing ->
               return $ unchanged
-                { npcState = Set $ NPCStanding 1 future
+                { npcMoveState = Set $ NPCStanding 1 future
                 }
       NPCWalking path -> do
         pos' <- query pos
@@ -152,7 +152,7 @@ updateNPCs imgmat rp dt =
           if distance pos' itarget < 0.1
           then
             return $ unchanged
-              { npcState = Set $ NPCWalking (tail path)
+              { npcMoveState = Set $ NPCWalking (tail path)
               }
           else
             return $ unchanged
@@ -166,9 +166,9 @@ updateNPCs imgmat rp dt =
           let mdir = 
                 (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
           -- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat
-          _ <- liftIO $ getPath (fmap floor pos') future rp imgmat
+          _ <- liftIO $ forkIO $ getPath (fmap floor pos') future rp imgmat
           return $ unchanged
-            { npcState = Set $ NPCStanding ttl future
+            { npcMoveState = Set $ NPCStanding ttl future
             , vel      = Set $ V2 0 0
             , rot      = Set $ fromMaybe rot' mdir
             , anim     = Set state

src/Test.hs

@@ -96,7 +96,7 @@ loadMapFork ud future progress = do
         , vel           = Just (V2 0 0)
         , velFact       = Just fact
         , rot           = Just SE
-        , npcState      = Just (NPCStanding 0 future)
+        , npcMoveState  = Just (NPCStanding 0 future)
         , anim          = Just $ AnimState (AnimId 1 "standing" SE) 0 0
         }
       ) npcposs

src/Types/UserData.hs

@@ -55,12 +55,12 @@ data Entity f = Entity
   , rot           :: Component f 'Field Direction
   , obstacle      :: Component f 'Field (Boundaries Double)
   , player        :: Component f 'Unique ()
-  , npcState      :: Component f 'Field NPCState
+  , npcMoveState  :: Component f 'Field NPCMoveState
   , anim          :: Component f 'Field AnimState
   }
   deriving (Generic)
 
-data NPCState
+data NPCMoveState
   = NPCWalking
     { npcWalkPath :: [V2 Int]
     }