essence-of-live-coding-gloss (empty) → 0.1.0.1
raw patch · 8 files changed
+267/−0 lines, 8 filesdep +basedep +essence-of-live-codingdep +foreign-storesetup-changed
Dependencies added: base, essence-of-live-coding, foreign-store, gloss, syb, transformers
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- essence-of-live-coding-gloss.cabal +51/−0
- src/LiveCoding/Gloss.hs +86/−0
- src/LiveCoding/Gloss/Debugger.hs +40/−0
- src/LiveCoding/Gloss/GHCi.hs +29/−0
- src/LiveCoding/Gloss/PictureM.hs +24/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for essence-of-live-coding-gloss++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Manuel Bärenz++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Manuel Bärenz nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ essence-of-live-coding-gloss.cabal view
@@ -0,0 +1,51 @@+name: essence-of-live-coding-gloss+version: 0.1.0.1+synopsis: General purpose live coding framework - Gloss backend+description:+ essence-of-live-coding is a general purpose and type safe live coding framework.+ .+ You can run programs in it, and edit, recompile and reload them while they're running.+ Internally, the state of the live program is automatically migrated when performing hot code swap.+ .+ The library also offers an easy to use FRP interface.+ It is parametrized by its side effects,+ separates data flow cleanly from control flow,+ and allows to develop live programs from reusable, modular components.+ There are also useful utilities for debugging and quickchecking.+ .+ This package contains a backend for Gloss (http://gloss.ouroborus.net/).++license: BSD3+license-file: LICENSE+author: Manuel Bärenz+maintainer: programming@manuelbaerenz.de+homepage: https://www.manuelbaerenz.de/#computerscience+category: FRP, Live coding+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git@github.com:turion/essence-of-live-coding.git++source-repository this+ type: git+ location: git@github.com:turion/essence-of-live-coding.git+ tag: v0.1.0.1++library+ exposed-modules:+ LiveCoding.Gloss+ LiveCoding.Gloss.Debugger+ LiveCoding.Gloss.GHCi+ LiveCoding.Gloss.PictureM+ build-depends:+ base >= 4.11 && <4.13+ , syb+ , transformers+ , essence-of-live-coding+ , foreign-store+ , gloss+ hs-source-dirs: src+ default-language: Haskell2010
+ src/LiveCoding/Gloss.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE Arrows #-}++module LiveCoding.Gloss+ ( module X+ , module LiveCoding.Gloss+ ) where++-- base+import Control.Concurrent+import Data.IORef++-- transformers+import Control.Monad.Trans.Writer++-- gloss+import Graphics.Gloss as X+import Graphics.Gloss.Interface.IO.Game as X++-- essence-of-live-coding+import LiveCoding++-- essence-of-live-coding-gloss+import LiveCoding.Gloss.Debugger as X+import LiveCoding.Gloss.PictureM as X++type GlossCellWorldForeground = (GlossCell, [Event], Picture)++playCellForeground :: GlossCell -> IO ()+playCellForeground cell = playIO (InWindow "Gears" (600, 800) (20, 20)) black stepRate (initialWorld cell) toPicture handleEvent playStep++type GlossCellWorld = (MVar GlossCell, [Event], Picture)++-- TODO Abstract external main loops+playCell :: GlossCell -> IO (MVar GlossCell)+playCell glossCell = do+ var <- newMVar glossCell+ forkIO $ playIO (InWindow "Gears" (600, 800) (20, 20)) black stepRate (initialWorld var) toPicture handleEvent playStepMVar+ return var++-- TODO Of course these are general for cells+updateGloss :: MVar GlossCell -> GlossCell -> IO ()+updateGloss var newGlossCell = do+ oldGlossCell <- takeMVar var+ putMVar var $ hotCodeSwapCell newGlossCell oldGlossCell++initialWorld cell = (cell, [], blank)+toPicture (_, _, picture) = do+ --putStrLn "toPicture"+ threadDelay 10000+ return picture+handleEvent event (cell, events, picture) = do+ --putStrLn "handleEvent"+ threadDelay 10000+ return (cell, event : events, picture)+playStep _ (cell, events, _) = do+ (picture, cell') <- fmap massageWriterOutput $ runWriterT $ step cell events+ threadDelay 10000+ --putStrLn "playStep"+ return (cell', [], picture)+playStepMVar _ (var, events, _) = do+ cell <- takeMVar var+ (picture, cell') <- fmap massageWriterOutput $ runWriterT $ step cell events+ putMVar var cell'+ threadDelay 10000+ --putStrLn "playStepMVar"+ return (var, [], picture)++glossWrap :: GlossCell -> IO (LiveProgram IO)+glossWrap cell = do+ pictureVar <- newMVar blank+ eventRef <- newIORef []+ stepVar <- newMVar 0+ let+ getPicture () = takeMVar pictureVar+ putEvent event () = modifyIORef eventRef $ (event :)+ putStep _ () = putMVar stepVar $ 1 / stepRate+ forkIO $ playIO (InWindow "Gears" (600, 800) (20, 20)) black stepRate () getPicture putEvent putStep+ let+ putPicture = putMVar pictureVar+ getEvents = atomicModifyIORef eventRef $ \events -> ([], events)+ getStep = takeMVar stepVar+ return $ liveCell $ proc _ -> do+ _ <- constM getStep -< ()+ events <- constM getEvents -< ()+ picture <- runPictureM cell -< events+ arrM putPicture -< picture
+ src/LiveCoding/Gloss/Debugger.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE Arrows #-}+module LiveCoding.Gloss.Debugger where++-- base+import Control.Arrow+import Data.Data++-- transformers+import Control.Monad.Trans.Writer+import Control.Monad.Trans.Class+import Control.Monad.Trans.State++-- syb+import Data.Generics.Text++-- gloss+import Graphics.Gloss++-- essence-of-live-coding+import LiveCoding++-- essence-of-live-coding-gloss+import LiveCoding.Gloss.PictureM++statePicture :: Data s => s -> Picture+statePicture = translate (-100) 200 . scale 0.2 0.2 . color red . text . stateShow++statePlay :: Debugger PictureM+statePlay = Debugger $ liveCell $ every 2 >>> keep blank >>> arrM (lift . tell)++every :: Data s => Integer -> Cell (StateT s PictureM) () (Maybe Picture)+every maxN = proc () -> do+ n <- sumC -< 1+ if n `mod` maxN == 0+ then do+ s <- getC -< ()+ let pic = statePicture s+ returnA -< Just pic+ else+ returnA -< Nothing
+ src/LiveCoding/Gloss/GHCi.hs view
@@ -0,0 +1,29 @@+module LiveCoding.Gloss.GHCi where++-- base+import Control.Concurrent++-- foreign-store+import Foreign.Store++-- essence-of-live-coding+import LiveCoding.LiveProgram++-- essence-of-live-coding-gloss+import LiveCoding.Gloss++livegloss "" = livegloss "glossCell"+livegloss glossCell = return $ unlines+ [ "var <- playCell " ++ glossCell+ , "saveGloss var"+ ]+livereloadgloss "" = livereloadgloss "glossCell"+livereloadgloss glossCell = return $ unlines+ [ ":reload"+ , "var <- loadGloss"+ , "updateGloss var " ++ glossCell+ ]+loadGloss :: IO (MVar GlossCell)+loadGloss = readStore (Store 0)+saveGloss :: MVar GlossCell -> IO ()+saveGloss var = writeStore (Store 0) var
+ src/LiveCoding/Gloss/PictureM.hs view
@@ -0,0 +1,24 @@+module LiveCoding.Gloss.PictureM where++-- transformers+import Control.Monad.Trans.Writer++-- gloss+import Graphics.Gloss+import Graphics.Gloss.Interface.IO.Game++-- essence-of-live-coding+import LiveCoding++type PictureM = WriterT Picture IO++runPictureM :: GlossCell -> Cell IO [Event] Picture+runPictureM = transformOutput $ fmap massageWriterOutput . runWriterT++massageWriterOutput (((), s), pic) = (pic, s)++-- TODO Rhine integration instead of fixed sample size+type GlossCell = Cell PictureM [Event] ()++addPicture :: Cell PictureM Picture ()+addPicture = arrM tell