optimization with new graphics library

This commit is contained in:
nek0 2023-12-04 22:05:22 +01:00
parent 99d16557ec
commit ab2d4b9add

View file

@ -2,7 +2,7 @@ module Main where
import Linear as L import Linear as L
import Data.Matrix as M import Data.Matrix as M hiding ((<->))
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Maybe import Data.Maybe
@ -76,19 +76,21 @@ main = do
return Nothing return Nothing
_ -> return Nothing _ -> return Nothing
outputs <- withMVar state draw outputs <- withMVar state draw
withMVar state (\s -> when (not (stop s)) $ do image <- withMVar state (\s -> do
let foutput = V.toList $ let foutput =
V.foldl (\acc a -> acc V.++ a V.++ V.singleton '\n') V.foldl (\acc a -> acc <-> a)
V.empty emptyImage
( outputs ( outputs
-- V.++ V.singleton (V.fromList $ show char) -- V.++ V.singleton (V.fromList $ show char)
-- V.++ V.singleton (V.fromList $ show (pos s) ++ " " ++ show (rot s)) -- V.++ V.singleton (V.fromList $ show (pos s) ++ " " ++ show (rot s))
V.++ V.singleton (V.empty) V.++ V.singleton (emptyImage)
V.++ V.singleton (V.empty) V.++ V.singleton (emptyImage)
V.++ V.singleton (V.empty) V.++ V.singleton (emptyImage)
) )
deepseq foutput (putStr foutput) pure foutput
) )
let picture = picForImage image
update vty picture
-- threadDelay msdelay -- threadDelay msdelay
-- hSetEcho stdin True -- hSetEcho stdin True
-- showCursor -- showCursor
@ -114,17 +116,17 @@ handleInput char state = do
_ -> state _ -> state
return nstate return nstate
draw :: State -> IO (V.Vector (V.Vector Char)) draw :: State -> IO (V.Vector Image)
draw (State ppos prot _ _ vty) = do draw (State ppos prot _ _ vty) = do
(w, h) <- displayBounds (outputIface vty) (w, h) <- displayBounds (outputIface vty)
let dims@(dw, dh) = (w, (h - 4)) let dims@(dw, dh) = (w, h - 4)
out = (V.generate (fromIntegral dh) out = V.generate (fromIntegral dh)
((\mh -> ((\mh -> string defAttr $ V.toList $
V.map V.map
(\mw -> drawPixel prot ppos dims (mw, mh)) (\mw -> drawPixel prot ppos dims (mw, mh))
(V.generate (fromIntegral dw) fromIntegral) (V.generate (fromIntegral dw) fromIntegral)
) . fromIntegral) ) . fromIntegral)
) `using` parVector `using` parVector
return out return out
drawPixel :: Double -> V2 Double -> (Int, Int) -> (Double, Double) -> Char drawPixel :: Double -> V2 Double -> (Int, Int) -> (Double, Double) -> Char