From 7cad9f6b02e2f71803047235622b9157ff988e75 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Wed, 31 Jul 2019 11:24:27 -0400
Subject: faster file loading.

---
 ByteStringUtil.hs | 29 +++++++++++++++++++++++++++++
 CubeMap.hs        |  3 ++-
 LoadMesh.hs       |  3 ++-
 lambda-gtk.cabal  |  3 ++-
 4 files changed, 35 insertions(+), 3 deletions(-)
 create mode 100644 ByteStringUtil.hs

diff --git a/ByteStringUtil.hs b/ByteStringUtil.hs
new file mode 100644
index 0000000..9711e0b
--- /dev/null
+++ b/ByteStringUtil.hs
@@ -0,0 +1,29 @@
+module ByteStringUtil where
+
+import Data.ByteString.Lazy.Internal
+import Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
+import System.IO
+import System.IO.Unsafe
+
+oneMeg :: Int
+oneMeg = 1048576
+
+hGetContentsN :: Int -> Handle -> IO ByteString
+hGetContentsN kk h = lazyRead
+  where
+    k = kk - chunkOverhead
+    lazyRead = unsafeInterleaveIO loop
+
+    loop = do
+        c <- S.hGetSome h k -- only blocks if there is no data available
+        if S.null c
+          then hClose h >> return Empty
+          else do cs <- lazyRead
+                  return (Chunk c cs)
+
+readBigFile :: FilePath -> IO ByteString
+readBigFile fname = do
+    h <- openFile fname ReadMode
+    hGetContentsN oneMeg h
+
diff --git a/CubeMap.hs b/CubeMap.hs
index e71892a..864bb57 100644
--- a/CubeMap.hs
+++ b/CubeMap.hs
@@ -4,6 +4,7 @@ module CubeMap
     , cubeMesh
     ) where
 
+import ByteStringUtil
 import LambdaCube.GL as LC
 import LambdaCube.GL.Data (uploadCubeMapToGPU)
 import LambdaCube.GL.Mesh as LC
@@ -70,7 +71,7 @@ loadSkyboxes = do
         , skyboxLoad  = \n -> do
                 let fn = zips !! mod n len
                 putStrLn $ "Loading skybox " ++ show n ++ ": " ++ fn ++ "..."
-                archive <- toArchive <$> Lazy.readFile (dir </> fn)
+                archive <- toArchive <$> readBigFile (dir </> fn)
                 let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive)
                 imgs <- fmap sequence $ forM es $ \entry -> do
                     return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry
diff --git a/LoadMesh.hs b/LoadMesh.hs
index 423630f..32e4f84 100644
--- a/LoadMesh.hs
+++ b/LoadMesh.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE TupleSections     #-}
 module LoadMesh where
 
+import ByteStringUtil
 import LambdaCube.GL as LC -- renderer
 import LambdaCube.GL.Mesh as LambdaCubeGL
 import LambdaCube.GL.Type as LC
@@ -54,7 +55,7 @@ relativeFrom path file | isAbsolute file = file
 relativeFrom path file = takeDirectory path </> file
 
 loadOBJ :: String -> IO (Either String MeshData)
-loadOBJ fname = L.readFile fname >>= \bs -> do
+loadOBJ fname = readBigFile fname >>= \bs -> do
     let  obj@OBJ{..} = Wavefront.parse bs
     -- load materials
     mtlLib <- if V.null objMtlLibs
diff --git a/lambda-gtk.cabal b/lambda-gtk.cabal
index da4c751..d262740 100644
--- a/lambda-gtk.cabal
+++ b/lambda-gtk.cabal
@@ -50,7 +50,8 @@ executable meshsketch
   other-modules:       InfinitePlane LambdaCubeWidget GLWidget LambdaCube.Gtk TimeKeeper
                        LoadMesh MtlParser Matrix LambdaCube.GL.HMatrix
                        Animator MeshSketch CubeMap AttributeData GPURing MaskableStream
-                       RingBuffer SmallRing VectorRing Camera Bezier FitCurves Mask Data.List.Merge
+                       RingBuffer SmallRing VectorRing Camera Bezier FitCurves Mask
+                       Data.List.Merge ByteStringUtil
   extensions:          NondecreasingIndentation
   other-extensions:    OverloadedLabels, OverloadedLists, OverloadedStrings
   build-depends:       base, containers >=0.5 && <0.6, bytestring >=0.10 && <0.11,
-- 
cgit v1.2.3