hylogen 0.1.2.3 → 0.1.3.0
raw patch · 6 files changed
+84/−44 lines, 6 filesdep +hintdep ~base
Dependencies added: hint
Dependency ranges changed: base
Files
- README.md +6/−4
- app/Main.hs +57/−25
- hylogen.cabal +3/−2
- src/Hylogen.hs +2/−0
- src/Hylogen/Program.hs +10/−2
- src/Hylogen/WithHylide/Core.hs +6/−11
README.md view
@@ -35,11 +35,11 @@  ## Usage-Here's a simple Hylogen program, saved as `Main.hs`:+Here's a simple Hylogen program, saved as `Example.hs`: ```haskell -module Main where+module Example where import Hylogen.WithHylide color :: Vec4@@ -50,7 +50,9 @@ a = sum [ cos (x_ uvN * f time + x_ mouse ) , sin (y_ uvN * f time + y_ mouse ) ]-main = putStrLn . toGLSL $ color++output :: Program+output = toProgram color ``` Run hylide:@@ -87,7 +89,7 @@ } ``` -Hylide will recompile and and rerun `main` on file changes, sending fresh shaders to the WebGL context via websockets.+Hylide will recompile on file changes, sending fresh shaders to the WebGL context via websockets.
app/Main.hs view
@@ -4,11 +4,12 @@ import Paths_hylogen (getDataFileName) import Control.Concurrent+import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS8 import qualified Data.Text as T-import Network.WebSockets+import qualified Network.WebSockets as S import System.Environment (getArgs) import System.FilePath import System.FSNotify@@ -19,6 +20,10 @@ import Network.Wai.Handler.Warp import Network.HTTP.Types (status200, status404) +import qualified Language.Haskell.Interpreter as I+import qualified Control.Exception as E++ data Msg = Err String | Code String deriving (Show)@@ -28,54 +33,81 @@ Err str -> object [ "error" .= str] Code str -> object [ "code" .= str] - main :: IO ()-main = getArgs >>= \case- [pathToWatch] -> main' pathToWatch- _ -> error "Error: Name a file to watch!"+main = do+ getArgs >>= \case+ [pathToWatch] -> main' pathToWatch+ _ -> error "Error: Name a file to watch!" main' :: FilePath -> IO () main' pathToWatch = do- _ <- forkIO serveIndex- serveGLSL pathToWatch+ tid1 <- forkIO serveIndex+ tid2 <- forkIO $ serveGLSL pathToWatch+ putStrLn "Press enter to exit."+ void getLine+ -- let fn = do+ -- killThread tid1+ -- killThread tid2+ -- die "diee"+ -- installHandler keyboardSignal (Catch fn) Nothing ++ serveGLSL :: FilePath -> IO () serveGLSL pathToWatch = do withManager- $ runServer "127.0.0.1" 8080+ $ S.runServer "127.0.0.1" 8080 . handleConnection pathToWatch+ return () -handleConnection :: FilePath -> WatchManager -> PendingConnection -> IO ()+handleConnection :: FilePath -> WatchManager -> S.PendingConnection -> IO () handleConnection pathToWatch mgr pending = do let (dirToWatch, _) = splitFileName pathToWatch- connection <- acceptRequest pending+ connection <- S.acceptRequest pending -- let send = sendTextData connection . T.pack- let send = sendTextData connection+ let send = S.sendTextData connection let update = do msg <- getCodeOrError pathToWatch send . encode $ msg - let onChange e = case e of- Modified _ _ -> update- _ -> return ()+ let onChange e = do+ case e of+ Modified _ _ -> update+ _ -> return () update _ <- watchDir mgr dirToWatch (const True) onChange _ <- getLine -- temp hack to keep the socket open return () +interp :: FilePath -> I.InterpreterT IO String+interp fp = do+ I.loadModules [fp]+ I.setImports [takeBaseName fp]+ I.eval "output"+ getCodeOrError :: FilePath -> IO Msg-getCodeOrError pathToWatch = do- -- TODO: more robust paths!:- -- c <- readFile pathToWatch- let (dirToWatch, _) = splitFileName pathToWatch- (ec, stdout, stderr) <- readProcessWithExitCode "runghc" [- "-i"++dirToWatch- , pathToWatch- ] ""- case ec of- ExitSuccess -> return (Code stdout)- ExitFailure _ -> return (Err stderr)+getCodeOrError path = do+ I.runInterpreter (interp path) >>= return . \case+ Left err -> case err of+ I.UnknownError str -> Err str+ I.WontCompile errors -> Err . mconcat $ I.errMsg <$> errors+ I.NotAllowed str -> Err str+ I.GhcException str -> Err str+ Right str -> Code str++-- getCodeOrError' :: FilePath -> IO Msg+-- getCodeOrError' pathToWatch = do+-- -- TODO: more robust paths!:+-- -- c <- readFile pathToWatch+-- let (dirToWatch, _) = splitFileName pathToWatch+-- (ec, stdout, stderr) <- readProcessWithExitCode "runghc" [+-- "-i"++dirToWatch+-- , pathToWatch+-- ] ""+-- case ec of+-- ExitSuccess -> return (Code stdout)+-- ExitFailure _ -> return (Err stderr) serveIndex :: IO () serveIndex = do
hylogen.cabal view
@@ -1,5 +1,5 @@ name: hylogen-version: 0.1.2.3+version: 0.1.3.0 synopsis: an EDSL for live-coding fragment shaders description: an EDSL for live-coding fragment shaders homepage: https://github.com/sleexyz/hylogen@@ -27,7 +27,7 @@ , Hylogen.WithHylide , Hylogen.WithHylide.Core , Hylogen.WithHylide.Util- build-depends: base >=4.8 && <4.9+ build-depends: base >= 4.8 && <=4.9 , vector-space , data-reify hs-source-dirs: src@@ -45,6 +45,7 @@ , text , websockets , aeson+ , hint , wai >=3.2 && <3.3 , http-types >=0.9 && <0.10 , warp >=3.2 && <3.3
src/Hylogen.hs view
@@ -1,7 +1,9 @@ module Hylogen ( module Hylogen.Types , module Hylogen.Globals+ , module Hylogen.Program ) where import Hylogen.Globals import Hylogen.Types+import Hylogen.Program (toProgram, Program)
src/Hylogen/Program.hs view
@@ -10,6 +10,7 @@ import System.IO.Unsafe import Hylogen.Expr+import Hylogen.Types.Vec (Vec4) newtype Id = Id Int instance Show Id where@@ -45,7 +46,14 @@ -- | Returns a program given an expression in closed untyped form-toProgram :: ExprMono -> Function-toProgram v = unsafePerformIO $ do+monoToProgram :: ExprMono -> Function+monoToProgram v = unsafePerformIO $ do Graph nodes _ <- reifyGraph v return . Function $ NewAssign <$> nodes++-- | A GLSL program. Currently synonym for Function.+type Program = Function++-- | Helper function from a Vec4 to A GLSL Program, with sharing.+toProgram :: Vec4 -> Program+toProgram = monoToProgram . toMono
src/Hylogen/WithHylide/Core.hs view
@@ -3,20 +3,15 @@ import Data.Monoid import Hylogen import Hylogen.Expr-import Hylogen.Program (toProgram) --- | Writes GLSL, without sharing-toGLSL' :: Vec4 -> String-toGLSL' v = unlines [ "void main() {"- , " gl_FragColor = " <> show v <> ";"- , "}"- ]-+-- Writes GLSL, without sharing+-- toGLSL' :: Vec4 -> String+-- toGLSL' v = unlines [ "void main() {"+-- , " gl_FragColor = " <> show v <> ";"+-- , "}"+-- ] --- | Writes GLSL, with sharing-toGLSL :: Vec4 -> String-toGLSL = show . toProgram . toMono -- | Pixel coordinates