.envrc

@@ -1 +0,0 @@
-use flake

.gitignore

@@ -8,7 +8,6 @@
 cabal.sandbox.config
 dist/
 dist-newstyle/
-.direnv/
 *.prof
 *.aux
 *.hp
@@ -19,4 +18,3 @@ dist-newstyle/
 *.eventlog
 *.*~
 .*autosave.kra
-result

cabal.config

@@ -0,0 +1,2 @@
+constraints: affection +verbose
+profiling: True

cabal.project

@@ -0,0 +1,4 @@
+packages:
+  ./
+  ../affection
+profiling: True

flake.lock

@@ -1,84 +0,0 @@
-{
-  "nodes": {
-    "affection-src": {
-      "inputs": {
-        "flake-utils": [
-          "flake-utils"
-        ],
-        "nixpkgs": [
-          "nixpkgs"
-        ]
-      },
-      "locked": {
-        "lastModified": 1700847735,
-        "narHash": "sha256-hSHgLPZwWP7tPoUhH2GLQ4GvHvVGFiXIM0CLps+O5KE=",
-        "ref": "refs/heads/master",
-        "rev": "d0465fa3e1d122503439df7c2de9d16598fc0cf5",
-        "revCount": 306,
-        "type": "git",
-        "url": "https://gitea.nek0.eu/nek0/affection"
-      },
-      "original": {
-        "type": "git",
-        "url": "https://gitea.nek0.eu/nek0/affection"
-      }
-    },
-    "flake-utils": {
-      "inputs": {
-        "systems": "systems"
-      },
-      "locked": {
-        "lastModified": 1694529238,
-        "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
-        "type": "github"
-      },
-      "original": {
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "type": "github"
-      }
-    },
-    "nixpkgs": {
-      "locked": {
-        "lastModified": 1700844339,
-        "narHash": "sha256-VRlPYk0eRn1ao75hoA99LGehYhxZH5RlkP1YXpVROHM=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "33576fdfce2d11204067d6cfa99a2f990ef2169a",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
-    "root": {
-      "inputs": {
-        "affection-src": "affection-src",
-        "flake-utils": "flake-utils",
-        "nixpkgs": "nixpkgs"
-      }
-    },
-    "systems": {
-      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
-        "type": "github"
-      }
-    }
-  },
-  "root": "root",
-  "version": 7
-}

flake.nix

@@ -1,46 +0,0 @@
-{
-  description = "A game stub written in Haskell";
-
-  inputs = {
-    nixpkgs.url = "github:NixOS/nixpkgs";
-    flake-utils.url = "github:numtide/flake-utils";
-    affection-src = {
-      url = "git+https://gitea.nek0.eu/nek0/affection";
-      inputs = {
-        nixpkgs.follows = "nixpkgs";
-        flake-utils.follows = "flake-utils";
-      };
-    };
-  };
-
-  outputs = { self, nixpkgs, flake-utils, affection-src }:
-    flake-utils.lib.eachDefaultSystem (system:
-      let
-        pkgs = nixpkgs.legacyPackages.${system};
-
-        haskellPackages = pkgs.haskellPackages;
-
-        jailbreakUnbreak = pkg:
-          pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
-
-        packageName = "tracer-game";
-      in rec {
-        packages.${packageName} = # (ref:haskell-package-def)
-          haskellPackages.callCabal2nix packageName self rec {
-            affection = affection-src.defaultPackage.${system};
-          };
-
-        defaultPackage = self.packages.${system}.${packageName};
-
-        devShell = haskellPackages.shellFor {
-          packages = p: [ defaultPackage ];
-          withHoogle = true;
-          buildInputs = with haskellPackages; [
-            haskell-language-server
-            ghcid
-            cabal-install
-          ] ++ (builtins.attrValues self.packages.${system});
-        };
-      });
-}
-

shell.nix

@@ -1,14 +1,102 @@
-{ pkgs ? import <nixpkgs> {}}:
+{ nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:
 
 let
-  # create a modified haskell package set with my package inside it and broken dependencies
+
-  # jailbroken.
+  inherit (nixpkgs) pkgs;
-  hpkgs = pkgs.haskellPackages.override {
+
-    overrides = hself: hsuper: {
+  affection = with haskellPackages; callPackage(
-      tracer-game = hself.callCabal2nix "tracer-game" (gitignore ./.) {};
+    { mkDerivation, base, bytestring, clock, containers, glib, linear
-      affection = hself.callCabal2nix "affection" (gitignore ../affection) {};
+    , monad-loops, monad-parallel, mtl, OpenGL, sdl2, stdenv, stm, text
+    , uuid, vector
+    }:
+    mkDerivation {
+      pname = "affection";
+      version = "0.0.0.10";
+      src = ../affection;
+      isLibrary = true;
+      isExecutable = true;
+      libraryHaskellDepends = [
+        base bytestring clock containers glib linear monad-loops
+        monad-parallel mtl OpenGL sdl2 stm text uuid vector
+      ];
+      homepage = "https://github.com/nek0/affection#readme";
+      description = "A simple Game Engine using SDL";
+      license = stdenv.lib.licenses.lgpl3;
+      doHaddock = false;
+    }) {};
+
+  algebraic-graphs = with haskellPackages; callPackage(
+    { mkDerivation, array, base, containers, deepseq, extra
+    , inspection-testing, mtl, QuickCheck, stdenv, transformers
+    }:
+    mkDerivation {
+      pname = "algebraic-graphs";
+      version = "0.5";
+      sha256 = "89b9fecf8245476ec823355125fcb95decf41fd9784e807d7bd0d09f0a79c50b";
+      libraryHaskellDepends = [
+        array base containers deepseq mtl transformers
+      ];
+      testHaskellDepends = [
+        array base containers deepseq extra inspection-testing mtl
+        QuickCheck transformers
+      ];
+      homepage = "https://github.com/snowleopard/alga";
+      description = "A library for algebraic graph construction and transformation";
+      license = stdenv.lib.licenses.mit;
+    }
+  ) {};
+
+  nanovg = with haskellPackages; callPackage(
+    { mkDerivation, base, bytestring, c2hs, containers, glew
+    , hspec, inline-c, libGL, libGLU, QuickCheck, stdenv, text, vector
+    }:
+    mkDerivation {
+      pname = "nanovg";
+      version = "0.6.0.0";
+      sha256 = "e35a2772f2a2e71916013cab70eeb8eedd6f66b5490ddf7ce237c8c76895d496";
+      revision = "1";
+      editedCabalFile = "1lhfsq50r9bdby7mfscw8ih3wsz2m19lr2a2z9b6diaf5kz76vij";
+      configureFlags = [ "-fgl3" ];
+      isLibrary = true;
+      isExecutable = true;
+      libraryHaskellDepends = [ base bytestring containers text vector ];
+      librarySystemDepends = [ glew libGL libGLU ];
+      libraryPkgconfigDepends = [ glew ];
+      libraryToolDepends = [ c2hs ];
+      testHaskellDepends = [ base containers hspec inline-c QuickCheck ];
+      homepage = "https://github.com/cocreature/nanovg-hs";
+      description = "Haskell bindings for nanovg";
+      license = stdenv.lib.licenses.isc;
+      doCheck = false;
+    }) {};
+
+  f = { mkDerivation, astar, base
+      , bytestring, containers, ecstasy, JuicyPixels, JuicyPixels-extra
+      , linear, matrix, mtl, OpenGL, parallel, random, sdl2
+      , split, stdenv, stm, text, unordered-containers, vector
+      }:
+      mkDerivation {
+        pname = "tracer-game";
+        version = "0.0.0.0";
+        src = ./.;
+        isLibrary = false;
+        isExecutable = true;
+        executableHaskellDepends = [
+          affection algebraic-graphs astar base bytestring containers ecstasy
+          JuicyPixels JuicyPixels-extra linear matrix mtl nanovg OpenGL
+          parallel random sdl2 split stm text unordered-containers vector
+        ];
+        license = stdenv.lib.licenses.gpl3;
       };
-  };
+
-  gitignore = dir: pkgs.nix-gitignore.gitignoreSource [] dir;
+  haskellPackages = if compiler == "default"
+                       then pkgs.haskellPackages
+                       else pkgs.haskell.packages.${compiler};
+
+  variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
+
+  drv = variant (haskellPackages.callPackage f {});
+
 in
-  hpkgs.tracer-game.env
+
+  if pkgs.lib.inNixShell then drv.env else drv

src/Init.hs

@@ -77,7 +77,7 @@ loadPlayerSprite fp w h nvg rids = do
         mapM (\(num, i) -> do
           let cr = crop (num * w) (row * h) w h img
           mresimg <-
-            createImageMem nvg (S.singleton ImagePremultiplied) (toStrict $ encodePng cr)
+            createImageMem nvg ImagePremultiplied (toStrict $ encodePng cr)
           case mresimg of
             Nothing     -> do
               logIO

src/Load.hs

@@ -8,19 +8,16 @@ import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar
 import Control.Monad
-import Control.Monad.Trans.Resource (ResIO)
 
 import qualified Data.Map as M
 import qualified Data.Text as T
 import Data.Ecstasy
 import Data.Maybe
-import qualified Data.Set as S
 import Data.String
 
 import System.Exit (exitFailure)
 
 import NanoVG hiding (V2(..))
-import NanoVG.Internal.Image
 
 -- internal imports
 
@@ -46,7 +43,7 @@ loadLoad ud = do
       (nano ud)
       (stateMVar ud)
       (stateProgress ud)
-  SDL.glMakeCurrent (fromJust curWin) (acContext $ head $ glContext ad)
+  SDL.glMakeCurrent (fromJust curWin) (snd $ head $ glContext ad)
   void $ liftIO $ swapMVar (state ud) Load
   void $ liftIO $ swapMVar (assetFonts ud) (M.fromList
     [ (FontBedstead, "bedstead")
@@ -54,12 +51,12 @@ loadLoad ud = do
     )
 
 loadFork
-  :: SystemState Entity (AffectionState (AffectionData) ResIO)
+  :: SystemState Entity (AffectionState (AffectionData) IO)
   -> SDL.Window
   -> SDL.GLContext
   -> Context
   -> MVar
-    ( SystemState Entity (AffectionState (AffectionData) ResIO)
+    ( SystemState Entity (AffectionState (AffectionData) IO)
     , StateData
     )
   -> MVar (Float, T.Text)
@@ -72,202 +69,202 @@ loadFork ws win glc nvg future progress = do
     ( p + increment
     , "Loading icon \"conntroller_blue\""
     )))
-  mcontrblue <- createImage nvg (FileName "assets/icons/controller_blue.png") (S.singleton ImagePremultiplied)
+  mcontrblue <- createImage nvg (FileName "assets/icons/controller_blue.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading icon \"controller_blue\""
     )))
-  mcontrgreen <- createImage nvg (FileName "assets/icons/controller_green.png") (S.singleton ImagePremultiplied)
+  mcontrgreen <- createImage nvg (FileName "assets/icons/controller_green.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading icon \"controller_green\""
     )))
-  mkbdblue <- createImage nvg (FileName "assets/icons/keyboard_blue.png") (S.singleton ImagePremultiplied)
+  mkbdblue <- createImage nvg (FileName "assets/icons/keyboard_blue.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading icon \"keyboard_blue\""
     )))
-  mkbdgreen <- createImage nvg (FileName "assets/icons/keyboard_green.png") (S.singleton ImagePremultiplied)
+  mkbdgreen <- createImage nvg (FileName "assets/icons/keyboard_green.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading icon \"keyboard_green\""
     )))
-  marrow <- createImage nvg (FileName "assets/icons/arrow.png") (S.singleton ImagePremultiplied)
+  marrow <- createImage nvg (FileName "assets/icons/arrow.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_asc\""
     )))
-  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") (S.singleton ImagePremultiplied)
+  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_desc\""
     )))
-  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") (S.singleton ImagePremultiplied)
+  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_corner_n\""
     )))
-  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") (S.singleton ImagePremultiplied)
+  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_corner_e\""
     )))
-  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") (S.singleton ImagePremultiplied)
+  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_corner_s\""
     )))
-  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") (S.singleton ImagePremultiplied)
+  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_corner_w\""
     )))
-  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") (S.singleton ImagePremultiplied)
+  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_t_ne\""
     )))
-  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") (S.singleton ImagePremultiplied)
+  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_t_se\""
     )))
-  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") (S.singleton ImagePremultiplied)
+  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_t_sw\""
     )))
-  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") (S.singleton ImagePremultiplied)
+  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_t_nw\""
     )))
-  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") (S.singleton ImagePremultiplied)
+  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"wall_cross\""
     )))
-  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") (S.singleton ImagePremultiplied)
+  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"box1\""
     )))
-  mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") (S.singleton ImagePremultiplied)
+  mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableSW\""
     )))
-  mtableSW <- createImage nvg (FileName "assets/table/tableSW.png") (S.singleton ImagePremultiplied)
+  mtableSW <- createImage nvg (FileName "assets/table/tableSW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableSE\""
     )))
-  mtableSE <- createImage nvg (FileName "assets/table/tableSE.png") (S.singleton ImagePremultiplied)
+  mtableSE <- createImage nvg (FileName "assets/table/tableSE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableNE\""
     )))
-  mtableNE <- createImage nvg (FileName "assets/table/tableNE.png") (S.singleton ImagePremultiplied)
+  mtableNE <- createImage nvg (FileName "assets/table/tableNE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableNW\""
     )))
-  mtableNW <- createImage nvg (FileName "assets/table/tableNW.png") (S.singleton ImagePremultiplied)
+  mtableNW <- createImage nvg (FileName "assets/table/tableNW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableC1\""
     )))
-  mtablec1 <- createImage nvg (FileName "assets/table/tablec1.png") (S.singleton ImagePremultiplied)
+  mtablec1 <- createImage nvg (FileName "assets/table/tablec1.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableC2\""
     )))
-  mtablec2 <- createImage nvg (FileName "assets/table/tablec2.png") (S.singleton ImagePremultiplied)
+  mtablec2 <- createImage nvg (FileName "assets/table/tablec2.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableC3\""
     )))
-  mtablec3 <- createImage nvg (FileName "assets/table/tablec3.png") (S.singleton ImagePremultiplied)
+  mtablec3 <- createImage nvg (FileName "assets/table/tablec3.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableC4\""
     )))
-  mtablec4 <- createImage nvg (FileName "assets/table/tablec4.png") (S.singleton ImagePremultiplied)
+  mtablec4 <- createImage nvg (FileName "assets/table/tablec4.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"tableCorner\""
     )))
-  mtableC <- createImage nvg (FileName "assets/table/tableCorner.png") (S.singleton ImagePremultiplied)
+  mtableC <- createImage nvg (FileName "assets/table/tableCorner.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"flipchart\""
     )))
-  mmiscFlipchart <- createImage nvg (FileName "assets/misc/flipchart.png") (S.singleton ImagePremultiplied)
+  mmiscFlipchart <- createImage nvg (FileName "assets/misc/flipchart.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"plant1\""
     )))
-  mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") (S.singleton ImagePremultiplied)
+  mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"plant2\""
     )))
-  mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") (S.singleton ImagePremultiplied)
+  mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"watercooler\""
     )))
-  mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") (S.singleton ImagePremultiplied)
+  mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"vending machine\""
     )))
-  mmiscVending <- createImage nvg (FileName "assets/misc/vending.png") (S.singleton ImagePremultiplied)
+  mmiscVending <- createImage nvg (FileName "assets/misc/vending.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with Coffee machine SW\""
     )))
-  mcabCoffeeSW <- createImage nvg (FileName "assets/cabinet/cabCoffeeSW.png") (S.singleton ImagePremultiplied)
+  mcabCoffeeSW <- createImage nvg (FileName "assets/cabinet/cabCoffeeSW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with Coffee machine SE\""
     )))
-  mcabCoffeeSE <- createImage nvg (FileName "assets/cabinet/cabCoffeeSE.png") (S.singleton ImagePremultiplied)
+  mcabCoffeeSE <- createImage nvg (FileName "assets/cabinet/cabCoffeeSE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with sink SW\""
     )))
-  mcabSinkSW <- createImage nvg (FileName "assets/cabinet/cabSinkSW.png") (S.singleton ImagePremultiplied)
+  mcabSinkSW <- createImage nvg (FileName "assets/cabinet/cabSinkSW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with sink SE\""
     )))
-  mcabSinkSE <- createImage nvg (FileName "assets/cabinet/cabSinkSE.png") (S.singleton ImagePremultiplied)
+  mcabSinkSE <- createImage nvg (FileName "assets/cabinet/cabSinkSE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with stove SW\""
     )))
-  mcabStoveSW <- createImage nvg (FileName "assets/cabinet/cabStoveSW.png") (S.singleton ImagePremultiplied)
+  mcabStoveSW <- createImage nvg (FileName "assets/cabinet/cabStoveSW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"Cabinet with stove SE\""
     )))
-  mcabStoveSE <- createImage nvg (FileName "assets/cabinet/cabStoveSE.png") (S.singleton ImagePremultiplied)
+  mcabStoveSE <- createImage nvg (FileName "assets/cabinet/cabStoveSE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"cabinet SW\""
     )))
-  mcabinetSW <- createImage nvg (FileName "assets/cabinet/cabinetSW.png") (S.singleton ImagePremultiplied)
+  mcabinetSW <- createImage nvg (FileName "assets/cabinet/cabinetSW.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"cabinet SE\""
     )))
-  mcabinetSE <- createImage nvg (FileName "assets/cabinet/cabinetSE.png") (S.singleton ImagePremultiplied)
+  mcabinetSE <- createImage nvg (FileName "assets/cabinet/cabinetSE.png") 0
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading asset \"cabinet corner\""
     )))
-  mcabinetCorner <- createImage nvg (FileName "assets/cabinet/cabinetCorner.png") (S.singleton ImagePremultiplied)
+  mcabinetCorner <- createImage nvg (FileName "assets/cabinet/cabinetCorner.png") 0
   let micons =
         [ mcontrblue, mcontrgreen, mkbdblue, mkbdgreen, marrow
         ]
@@ -337,18 +334,6 @@ loadFork ws win glc nvg future progress = do
     )))
   jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
     (zip (walkIds AnimJDoeM) walkConfigs)
-  modifyMVar_ progress (return . (\(p, _) ->
-    ( p + increment
-    , "Loading Animation \"policem: standing\""
-    )))
-  policemStanding <- loadAnimationSprites "assets/policem.png" nvg
-    (zip (standIds AnimPoliceM) standConfigs)
-  modifyMVar_ progress (return . (\(p, _) ->
-    ( p + increment
-    , "Loading Animation \"policem: walking\""
-    )))
-  policemWalking <- loadAnimationSprites "assets/policem.png" nvg
-    (zip (walkIds AnimPoliceM) walkConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"copier: stand\""
@@ -521,8 +506,6 @@ loadFork ws win glc nvg future progress = do
           playerWalking ++
           jdoemStanding ++
           jdoemWalking ++
-          policemStanding ++
-          policemWalking ++
           copierStand ++
           copierCopy ++
           cornerComputerOff ++

src/Main.hs

@@ -17,7 +17,6 @@ import Data.Maybe (fromJust)
 
 import Control.Monad
 import Control.Concurrent.MVar
-import Control.Monad.Trans.Resource (allocate)
 
 -- internal imports
 
@@ -46,7 +45,7 @@ main = do
         , windowConfigs   =
           [ ( 0
             , SDL.defaultWindow
-              { SDL.windowInitialSize     = V2 1920 1080
+              { SDL.windowInitialSize     = V2 1280 720
               , SDL.windowResizable       = True
               , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
                 { SDL.glProfile = SDL.Core SDL.Normal 3 3
@@ -61,18 +60,17 @@ main = do
 pre :: UserData -> Affection ()
 pre ud = do
   ad <- A.get
-  let (AffectionWindow awwindow _ _) = head $ drawWindows ad
+  threadCtx <- SDL.glCreateContext ((\(_, y, _) -> y) $ head $ drawWindows ad)
-  threadCtx <- SDL.glCreateContext awwindow
+  SDL.glMakeCurrent ((\(_, y, _) -> y) $ head $ drawWindows ad) (snd $ head $ glContext ad)
-  SDL.glMakeCurrent awwindow (acContext $ head $ glContext ad)
   let Subsystems w _ k j _ = subsystems ud
-  _ <- partSubscribe w (fitViewport (1920/1080))
+  _ <- partSubscribe w (fitViewport (1280/720))
   _ <- partSubscribe w (exitOnWindowClose ud)
   _ <- partSubscribe k toggleFullScreen
   _ <- partSubscribe k (quitGame ud)
   u <- partSubscribe j (cacheJoypad ud)
   (ws, _) <- yieldSystemT (0, defStorage) (return ())
   void $ liftIO $ swapMVar (threadContext ud) (Just threadCtx)
-  void $ liftIO $ swapMVar (window ud) (Just awwindow)
+  void $ liftIO $ swapMVar (window ud) (Just $ (\(_, y, _) -> y) $ head $ drawWindows ad)
   void $ liftIO $ putMVar (worldState ud) ws
   void $ liftIO $ putMVar (joyUUID ud) u
 
@@ -92,8 +90,8 @@ quitGame ud (MsgKeyboardEvent _ _ SDL.Pressed False sym)
       mapM_ (partUnSubscribe j) curUUID
       mapM_ (partUnSubscribe t) curUUID
       SDL.glMakeCurrent
-        (awWindow $ head $ drawWindows ad)
+        ((\(_, y, _) -> y) $ head $ drawWindows ad)
-        (acContext $ head $ glContext ad)
+        (snd $ head $ glContext ad)
       (ws, _) <- yieldSystemT (0, defStorage) (return ())
       void $ liftIO $ swapMVar (worldState ud) ws
       void $ liftIO $ swapMVar (state ud) Load

src/MainGame/WorldMap.hs

@@ -12,7 +12,6 @@ import NanoVG hiding (V2(..))
 
 import Control.Monad (when, void)
 import Control.Monad.State.Strict (evalStateT)
-import Control.Monad.Trans.Resource (ResIO, runResourceT)
 import Control.Concurrent.MVar
 import Control.Concurrent (forkIO)
 import Control.Parallel.Strategies hiding (dot)
@@ -86,7 +85,7 @@ changeMaps2 _ _ = return ()
 loadMapFork
   :: UserData
   -> AffectionData
-  -> MVar (SystemState Entity (AffectionState AffectionData ResIO), StateData)
+  -> MVar (SystemState Entity (AffectionState AffectionData IO), StateData)
   -> MVar (Float, T.Text)
   -> IO ()
 loadMapFork ud ad future progress = do
@@ -95,7 +94,7 @@ loadMapFork ud ad future progress = do
       fc = FloorConfig
         (V2 10 10)
         [(V2 5 5), (V2 5 20)]
-        (40, 40)
+        (50, 50)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Building floor"
@@ -131,7 +130,7 @@ loadMapFork ud ad future progress = do
     , "Creating WorldState"
     )))
   wState <- liftIO $ readMVar (worldState ud)
-  (nws, mmimgmat) <- runResourceT $ evalStateT (runState (yieldSystemT wState $ do
+  (nws, mmimgmat) <- evalStateT (runState (yieldSystemT wState $ do
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
       ( p + increment
       , "Registering copiers into WorldState"
@@ -249,7 +248,6 @@ loadMapFork ud ad future progress = do
         <*> (randomRIO (0, 1))
         <*> (randomRIO (0, 1))
         <*> (randomRIO (0, 1))
-      police <- liftIO $ randomRIO (0 :: Int, 9 :: Int)
       let room = V.head
             (V.filter
               ((inBounds $ pointCoord cpr) . bounds)
@@ -266,8 +264,7 @@ loadMapFork ud ad future progress = do
         , npcActionState = Just ASWork
         , npcStats       = Just stats
         , clearanceLvl   = Just (clearance room)
-        , anim           = Just $ AnimState
+        , anim           = Just $ AnimState (AnimId AnimJDoeM "standing" SE) 0 0
-          (AnimId (if police == 0 then AnimPoliceM else AnimJDoeM) "standing" SE) 0 0
         }
       ) computers
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
@@ -620,12 +617,10 @@ drawMap ud = do
           "FPS: "
           <> T.pack (Prelude.take 5 $ show (1/dt))
           <> " Clearance: "
-          <> (if not (Prelude.null room)
+          <> if not (Prelude.null room)
             then T.pack (show $ clearance $ V.head room)
             else "0"
             )
-          -- <> "\nFor answers call 6350"
-          )
 
 drawTile
   :: UserData

src/NPC.hs

@@ -15,7 +15,6 @@ import Data.String
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans (lift)
-import Control.Monad.Trans.Resource (ResIO)
 import Control.Concurrent.MVar
 import Control.Concurrent (forkIO)
 
@@ -34,7 +33,7 @@ import Object ()
 getPosBounds
   :: SystemT
     Entity
-    (AffectionState AffectionData ResIO)
+    (AffectionState AffectionData IO)
     [(V2 Double, Boundaries Double)]
 getPosBounds = do
   efor allEnts $ do
@@ -48,10 +47,10 @@ getPosBounds = do
 updateNPCs
   :: M.Matrix (Maybe ImgId)
   -> M.Matrix TileState
-  -> SystemState Entity (AffectionState AffectionData ResIO)
+  -> SystemState Entity (AffectionState AffectionData IO)
   -> V.Vector ReachPoint
   -> Double
-  -> SystemT Entity (AffectionState AffectionData ResIO) ()
+  -> SystemT Entity (AffectionState AffectionData IO) ()
 updateNPCs imgmat tsmat ws rrp dt = do
   updateStats dt
   posbounds <- getPosBounds
@@ -264,7 +263,7 @@ standStill imgmat tsmat pos' rot' ws posbounds rp = do
 
 updateStats
   :: Double
-  -> SystemT Entity (AffectionState AffectionData ResIO) ()
+  -> SystemT Entity (AffectionState AffectionData IO) ()
 updateStats dt =
   emap allEnts $ do
     with npcStats

src/Types/Animation.hs

@@ -46,7 +46,6 @@ data AnimationName
   | AnimComputer
   | AnimToilet
   | AnimJDoeM
-  | AnimPoliceM
   | AnimDoor0
   deriving (Show, Eq, Ord, Enum)
 

src/Types/ObjClass.hs

@@ -5,7 +5,6 @@ module Types.ObjClass where
 
 import Affection
 
-import Control.Monad.Trans.Resource (ResIO)
 import Data.Ecstasy
 
 import Types.Entity
@@ -16,7 +15,7 @@ class ObjectAction otype ostate where
     -> otype
     -> ostate
     -> Ent
-    -> SystemT Entity (AffectionState AffectionData ResIO) ()
+    -> SystemT Entity (AffectionState AffectionData IO) ()
 
   objectTransition
     :: otype
@@ -24,7 +23,7 @@ class ObjectAction otype ostate where
     -> Bool
     -> Ent
     -> Maybe Ent
-    -> SystemT Entity (AffectionState AffectionData ResIO) (Entity 'SetterOf)
+    -> SystemT Entity (AffectionState AffectionData IO) (Entity 'SetterOf)
 
 class ActionTime otype ostate where
   actionTime :: otype -> ostate -> Double

src/Types/UserData.hs

@@ -16,7 +16,6 @@ import qualified Data.Text as T
 import Data.Ecstasy
 
 import Control.Concurrent.MVar
-import Control.Monad.Trans.Resource
 
 import Types.StateData
 import Types.ImgId
@@ -35,10 +34,10 @@ data UserData = UserData
   , translation     :: MVar Translation
   , nano            :: Context
   , uuid            :: MVar [UUID]
-  , worldState      :: MVar (SystemState Entity (AffectionState AffectionData ResIO))
+  , worldState      :: MVar (SystemState Entity (AffectionState AffectionData IO))
   , stateData       :: MVar StateData
   , stateMVar       :: MVar
-    ( SystemState Entity (AffectionState AffectionData ResIO)
+    ( SystemState Entity (AffectionState AffectionData IO)
     , StateData
     )
   , stateProgress   :: MVar (Float, T.Text)

src/Util.hs

@@ -257,7 +257,7 @@ loadAnimationSprites fp nvg idconfs = do
           mresimgs <- mapM
             (\cr ->
               createImageMem nvg
-                (S.singleton ImagePremultiplied) (toStrict $ encodePng cr))
+                ImagePremultiplied (toStrict $ encodePng cr))
             crs
           imgs <- if any isNothing mresimgs
             then do

tracer-game.cabal

@@ -80,7 +80,6 @@ executable tracer-game
                      , mtl
                      , parallel
                      , split
-                     , resourcet
   hs-source-dirs:      src
   ghc-options:         -Wall -threaded
   default-language:    Haskell2010