hylogen (empty) → 0.1.0.0
raw patch · 7 files changed
+308/−0 lines, 7 filesdep +basedep +filepathdep +hinotifysetup-changed
Dependencies added: base, filepath, hinotify, process, random, text, websockets
Files
- README.md +12/−0
- Setup.hs +2/−0
- app/Main.hs +63/−0
- hylogen.cabal +34/−0
- src/Hylogen.hs +38/−0
- src/Hylogen/Globals.hs +26/−0
- src/Hylogen/Types.hs +133/−0
+ README.md view
@@ -0,0 +1,12 @@+# <i>H Y L O G E N</i>++Hylogen is a tiny language [embedded in Haskell](https://wiki.haskell.org/Embedded_domain_specific_language) for live-coding visuals.+++[hylogen.com](http://hylogen.com)+++## setup+```+tbc...+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}++import Data.Monoid+import qualified Data.Text as T+import Network.WebSockets+import System.Environment (getArgs)+import System.FilePath+import System.INotify+import System.Process+import System.Random++main :: IO ()+main = getArgs >>= \case+ [pathToWatch] ->+ runServer "127.0.0.1" 8080 $ handleConnection pathToWatch+ _ -> error "Name a file to watch!"++handleConnection :: FilePath -> PendingConnection -> IO ()+handleConnection pathToWatch pending = do+ let (dirToWatch, fileToWatch) = splitFileName pathToWatch+ inotify <- initINotify+ print inotify+ connection <- acceptRequest pending+ (sendTextData connection . T.pack) =<< getNewSource pathToWatch+ -- withINotify $ \inotify ->+ addWatch inotify [Modify] dirToWatch $ \case+ Modified False (Just f) | f == fileToWatch ->+ (sendTextData connection . T.pack) =<< getNewSource pathToWatch+ _ -> return ()+-- print wd+-- removeWatch wd+-- receiveDataMessage connection+ _ <- getLine -- temp hack to keep the socket open+ return ()++getNewSource :: FilePath -> IO String+getNewSource pathToWatch = do+ -- TODO: more robust paths!:+ c <- readFile pathToWatch+ -- let (dirToWatch, fileToWatch) = splitFileName pathToWatch+ -- c <- readProcess "runghc" [+ -- "-i"++dirToWatch+ -- , pathToWatch+ -- ] ""+ putStrLn c+ return c+{-+ color <- randomRIO (0::Float, 1)+ + return $ unlines [+ "precision mediump float;"+ , "uniform float time;"+ , "uniform vec3 mouse;"+ , "const float PI = 3.141592653589793238462643383;"+ , "varying vec3 uv;"+ , ""+ , "void main() {"+ , " gl_FragColor = vec4("++show color++", 0.0, 0.0, 1.0);"+ , "}"+ ]+-}
+ hylogen.cabal view
@@ -0,0 +1,34 @@+name: hylogen+version: 0.1.0.0+synopsis: glsl edsl+homepage: https://github.com/sleexyz/hylogen+author: Sean Lee+license: MIT+maintainer: freshdried@gmail.com+category: Graphics+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+++library+ exposed-modules: Hylogen+ , Hylogen.Types+ , Hylogen.Globals+ build-depends: base >=4.8 && <4.9+ hs-source-dirs: src+ -- ghc-options: -dynamic+ default-language: Haskell2010+ +executable hylogen+ main-is: Main.hs+ build-depends: base+ , websockets+ , hinotify+ , text+ , filepath+ , random+ , process+ hs-source-dirs: app+ -- ghc-options: -dynamic+ default-language: Haskell2010
+ src/Hylogen.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonoLocalBinds #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Hylogen+ ( module Hylogen+ , module Hylogen.Types+ , module Hylogen.Globals+ )+ where++import Data.Monoid+import Hylogen.Types+import Hylogen.Globals++toGLSL :: Vec4 -> String+toGLSL x = unlines $ [ boiler+ , "void main() {"+ , " gl_FragColor = " <> show x <> ";"+ , "}"+ ]+ where+ boiler = unlines $ [ "precision mediump float;"+ , "uniform float time;"+ , "uniform vec3 mouse;"+ , "const float PI = 3.141592653589793238462643383; "+ , "varying vec3 uv;"+ ]
+ src/Hylogen/Globals.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++module Hylogen.Globals where++import Hylogen.Types+++-- | Vec1:++pi = V1u "pi"+time = V1u "time"+-- rand_ = V1uop "rand"+++fract :: Vec1 -> Vec1+fract = V1uop "fract"+++++-- | Vec2:++uv = V2u "uv"+++-- coord_ = V4u "gl_FragCoord"
+ src/Hylogen/Types.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE DeriveFunctor#-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoMonoLocalBinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Hylogen.Types where++import Data.Monoid+++class Show a => HasX a+class HasX a => HasY a+class HasY a => HasZ a+class HasZ a => HasW a+++data Vec1 where+ Vec1 :: Float -> Vec1+ V1u :: String -> Vec1+ V1uop :: String -> Vec1 -> Vec1+ V1uoppre :: String -> Vec1 -> Vec1+ V1bop :: String -> Vec1 -> Vec1 -> Vec1+ V1boppre :: String -> Vec1 -> Vec1 -> Vec1+ X :: (HasX a) => a -> Vec1+ Y :: (HasY a) => a -> Vec1+ Z :: (HasZ a) => a -> Vec1+ W :: (HasW a) => a -> Vec1++instance Show Vec1 where+ show expr = case expr of+ Vec1 x -> show x+ V1u x -> x+ V1uop u x -> u <> "(" <> show x <> ")"+ V1uoppre u x -> "(" <> u <> show x <> ")"+ V1bop b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+ V1boppre b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+ X x -> show x <> ".x"+ Y x -> show x <> ".y"+ Z x -> show x <> ".z"+ W x -> show x <> ".w"+++instance Num Vec1 where+ (+) = V1bop "+"+ (*) = V1bop "*"+ negate = V1uoppre "-"+ abs = V1uop "abs"+ signum = V1uop "sign"+ fromInteger = Vec1 . fromInteger+++instance Fractional Vec1 where+ (/) = V1bop "/"+ recip = V1bop "/" 1+ fromRational = Vec1 . fromRational++instance Floating Vec1 where+ pi = V1u "pi"+ exp = V1uop "exp"+ log = V1uop "log"+ sqrt = V1uop "sqrt"+ (**) = V1boppre "pow"+ sin = V1uop "sin"+ cos = V1uop "cos"+ tan = V1uop "tan"+ asin = V1uop "asin"+ acos = V1uop "acos"+ atan = V1uop "atan"+ sinh x = (exp x - exp (negate x))/2+ cosh x = (exp x + exp (negate x))/2+ tanh x = sinh x / cosh x+ asinh x = log $ x + sqrt(x**2 + 1)+ acosh x = log $ x + sqrt(x**2 - 1)+ atanh x = 0.5 * log ((1 + x)/(1 - x))+++-- | Vec2:++data Vec2 where+ Vec2 :: (Vec1, Vec1) -> Vec2+ V2u :: String -> Vec2++instance Show Vec2 where+ show expr = case expr of+ Vec2 (x, y) -> "vec2(" <> show x <> ", " <> show y <> ")"+ V2u x -> x++instance HasX Vec2+instance HasY Vec2+++-- | Vec3:++data Vec3 where+ Vec3 :: (Vec1, Vec1, Vec1) -> Vec3+ V3u :: String -> Vec3++instance Show Vec3 where+ show expr = case expr of+ Vec3 (x, y, z) -> "vec3(" <> show x <> ", " <> show y <> ", " <> show z <> ")"+ V3u x -> x++instance HasX Vec3+instance HasY Vec3+instance HasZ Vec3+++-- | Vec4:++data Vec4 where+ Vec4 :: (Vec1, Vec1, Vec1, Vec1) -> Vec4+ V4u :: String -> Vec4++instance Show Vec4 where+ show expr = case expr of+ Vec4 (x, y, z, w) -> "vec4(" <> show x <> ", " <> show y <> ", " <> show z <> ", " <> show w <> ")"+ V4u x -> x++instance HasX Vec4+instance HasY Vec4+instance HasZ Vec4+instance HasW Vec4