diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,209 @@ +LISP SUPERCOLLIDER +------------------ + +AMERICAN PRIMITIVE, VOL. 2 + +`HSC3-LISP` is a simple [LISP][lisp] interpreter. + +The only data type is the [SUPERCOLLIDER][sc3] `UNIT GENERATOR`. + +A LISP answer to the eternal question, +[WHY SUPERCOLLIDER?](sw/hsc3-graphs/html/why-supercollider.scd.html) + +~~~~ +(HEAR + (LET ((R (RESONZ (MUL (DUST AR 0.2) 50) (RAND 200 3200) 0.003)) + (S (MIX (CLONE 10 R))) + (Z (DELAY-N S 0.048 0.048)) + (C (COMB-L Z 0.1 (MUL-ADD (LF-NOISE1 KR (RAND 0 0.1)) 0.04 0.05) 15)) + (Y (MIX (CLONE 7 C))) + (F (LAMBDA (I) (ALLPASS-N I 0.05 (CLONE 2 (RAND 0 0.05)) 1))) + (X ((FOLDL1 COMPOSE (REPLICATE 4 F)) Y))) + (ADD S (MUL X 0.2)))) +~~~~ + +There is an OSX (10.9.3) binary ([hsc3-lisp](sw/hsc3-lisp/osx/hsc3-lisp.xz).[xz](http://tukaani.org/xz/)), +or to build type: + +~~~~ +cd hs ; prefix=~/opt make install +~~~~ + +An environment variable locates the HSC3-LISP library files: + +~~~~ +export HSC3_LISP_DIR=$HOME/sw/hsc3-lisp/lisp +~~~~ + +To hear the above type `C-cC-e` in EMACS, or in a shell type: + +~~~~ +hsc3-lisp ~/sw/rsc3/help/graph/why-supercollider.scm +~~~~ + +There is a [TUTORIAL](?t=hsc3-lisp&e=help/tutorial.lisp), +and [TRANSLATIONS](?t=hsc3-lisp&e=help/jmcc.lisp) of graphs by [JAMES +MCCARTNEY](http://audiosynth.com/autobio/emu.jpg) from the `SC2` +manual. + +HSC3-LISP is `CASE-INSENSITIVE`, in EMACS you can type `C-x C-l` to +time travel. + +HSC3-LISP follows the [HASKELL][hs] supercollider ([HSC3][hsc3]) rules. + +HSC3-LISP thinks `scsynth` is listening at the standard port (57110). + +HSC3-LISP is POST-[ML](http://standardml.org), `(EQUAL? (MAP (+ 1) (LIST 1 2 3)) (LIST 2 3 4))`. + +HSC3-LISP is not [SCHEME][scheme]. Still, the following [RSC3][rsc3] graphs are working: + +- [aleatoric-quartet.lisp](sw/rsc3/help/graph/aleatoric-quartet.lisp) +- [alien-froggies.lisp](sw/rsc3/help/graph/alien-froggies.lisp) +- [alien-meadow.lisp](sw/rsc3/help/graph/alien-meadow.lisp) +- [analog-bubbles.lisp](sw/rsc3/help/graph/analog-bubbles.lisp) +- [analog-bubbles-mouse.lisp](sw/rsc3/help/graph/analog-bubbles-mouse.lisp) +- [analogue-daze.lisp](sw/rsc3/help/graph/analogue-daze.lisp) +- [babbling-brook.lisp](sw/rsc3/help/graph/babbling-brook.lisp) +- [berlin-1977.lisp](sw/rsc3/help/graph/berlin-1977.lisp) +- [bit-reduction.lisp](sw/rsc3/help/graph/bit-reduction.lisp) +- [blips-001.lisp](sw/rsc3/help/graph/blips-001.lisp) +- [bottle.lisp](sw/rsc3/help/graph/bottle.lisp) +- [bouncing-objects.lisp](sw/rsc3/help/graph/bouncing-objects.lisp) +- [bowed-string.lisp](sw/rsc3/help/graph/bowed-string.lisp) +- [ccomb.lisp](sw/rsc3/help/graph/ccomb.lisp) +- [chain-saw.lisp](sw/rsc3/help/graph/chain-saw.lisp) +- [choip.lisp](sw/rsc3/help/graph/choip.lisp) +- [chrd.lisp](sw/rsc3/help/graph/chrd.lisp) +- [clustered-sines.lisp](sw/rsc3/help/graph/clustered-sines.lisp) +- [coolant.lisp](sw/rsc3/help/graph/coolant.lisp) +- [cricket.lisp](sw/rsc3/help/graph/cricket.lisp) +- [crotale.lisp](sw/rsc3/help/graph/crotale.lisp) +- [cut-outs.lisp](sw/rsc3/help/graph/cut-outs.lisp) +- [cymbalism-accelerando.lisp](sw/rsc3/help/graph/cymbalism-accelerando.lisp) +- [cymbalism.lisp](sw/rsc3/help/graph/cymbalism.lisp) +- [data-space.lisp](sw/rsc3/help/graph/data-space.lisp) +- [deep-sea.lisp](sw/rsc3/help/graph/deep-sea.lisp) +- [demanding-studies.lisp](sw/rsc3/help/graph/demanding-studies.lisp) +- [dial-history.lisp](sw/rsc3/help/graph/dial-history.lisp) +- [diffraction.lisp](sw/rsc3/help/graph/diffraction.lisp) +- [discretion.lisp](sw/rsc3/help/graph/discretion.lisp) +- [doppler.lisp](sw/rsc3/help/graph/doppler.lisp) +- [drummer.lisp](sw/rsc3/help/graph/drummer.lisp) +- [eggcrate.lisp](sw/rsc3/help/graph/eggcrate.lisp) +- [f-lets.lisp](sw/rsc3/help/graph/f-lets.lisp) +- [fm-iter.lisp](sw/rsc3/help/graph/fm-iter.lisp) +- [forest-sounds.lisp](sw/rsc3/help/graph/forest-sounds.lisp) +- [fwalk.lisp](sw/rsc3/help/graph/fwalk.lisp) +- [half-life.lisp](sw/rsc3/help/graph/half-life.lisp) +- [hard-sync-sawtooth-with-lfo.lisp](sw/rsc3/help/graph/hard-sync-sawtooth-with-lfo.lisp) +- [harmonic-swimming.lisp](sw/rsc3/help/graph/harmonic-swimming.lisp) +- [harmonic-tumbling.lisp](sw/rsc3/help/graph/harmonic-tumbling.lisp) +- [h-chatter.lisp](sw/rsc3/help/graph/h-chatter.lisp) +- [hell-is-busy.lisp](sw/rsc3/help/graph/hell-is-busy.lisp) +- [hh-808.lisp](sw/rsc3/help/graph/hh-808.lisp) +- [implosion.lisp](sw/rsc3/help/graph/implosion.lisp) +- [impulse-sequencer.lisp](sw/rsc3/help/graph/impulse-sequencer.lisp) +- [karplus-strong.lisp](sw/rsc3/help/graph/karplus-strong.lisp) +- [klink.lisp](sw/rsc3/help/graph/klink.lisp) +- [k-ppr.lisp](sw/rsc3/help/graph/k-ppr.lisp) +- [lfo-modulation.lisp](sw/rsc3/help/graph/lfo-modulation.lisp) +- [lf-pulses.lisp](sw/rsc3/help/graph/lf-pulses.lisp) +- [lg-timed.lisp](sw/rsc3/help/graph/lg-timed.lisp) +- [lots-o-sines.lisp](sw/rsc3/help/graph/lots-o-sines.lisp) +- [lz-bf.lisp](sw/rsc3/help/graph/lz-bf.lisp) +- [modal-space-buf.lisp](sw/rsc3/help/graph/modal-space-buf.lisp) +- [modal-space.lisp](sw/rsc3/help/graph/modal-space.lisp) +- [moto-rev.lisp](sw/rsc3/help/graph/moto-rev.lisp) +- [mouse-clatter.lisp](sw/rsc3/help/graph/mouse-clatter.lisp) +- [narrow-band-filtered-crackle-noise.lisp](sw/rsc3/help/graph/narrow-band-filtered-crackle-noise.lisp) +- [nharm.lisp](sw/rsc3/help/graph/nharm.lisp) +- [noise-burst-sweep.lisp](sw/rsc3/help/graph/noise-burst-sweep.lisp) +- [one-line.lisp](sw/rsc3/help/graph/one-line.lisp) +- [oscillator-cluster.lisp](sw/rsc3/help/graph/oscillator-cluster.lisp) +- [pattern-buffer.lisp](sw/rsc3/help/graph/pattern-buffer.lisp) +- [plucked-strings.lisp](sw/rsc3/help/graph/plucked-strings.lisp) +- [police-state.lisp](sw/rsc3/help/graph/police-state.lisp) +- [pond-life.lisp](sw/rsc3/help/graph/pond-life.lisp) +- [pulsing-bottles.lisp](sw/rsc3/help/graph/pulsing-bottles.lisp) +- [rails.lisp](sw/rsc3/help/graph/rails.lisp) +- [random-pulsations.lisp](sw/rsc3/help/graph/random-pulsations.lisp) +- [random-sine-waves.lisp](sw/rsc3/help/graph/random-sine-waves.lisp) +- [record-scratcher.lisp](sw/rsc3/help/graph/record-scratcher.lisp) +- [red-frik.lisp](sw/rsc3/help/graph/red-frik.lisp) +- [reset.lisp](sw/rsc3/help/graph/reset.lisp) +- [resonant-dust.lisp](sw/rsc3/help/graph/resonant-dust.lisp) +- [resonators-harmonic-series.lisp](sw/rsc3/help/graph/resonators-harmonic-series.lisp) +- [reso-pulse.lisp](sw/rsc3/help/graph/reso-pulse.lisp) +- [reverberated-noise-bursts.lisp](sw/rsc3/help/graph/reverberated-noise-bursts.lisp) +- [reverberated-sine-percussion.lisp](sw/rsc3/help/graph/reverberated-sine-percussion.lisp) +- [ring-modulated-klank.lisp](sw/rsc3/help/graph/ring-modulated-klank.lisp) +- [rzblp.lisp](sw/rsc3/help/graph/rzblp.lisp) +- [sample-and-hold-liquidities.lisp](sw/rsc3/help/graph/sample-and-hold-liquidities.lisp) +- [s-chirp.lisp](sw/rsc3/help/graph/s-chirp.lisp) +- [scratchy.lisp](sw/rsc3/help/graph/scratchy.lisp) +- [scritto.lisp](sw/rsc3/help/graph/scritto.lisp) +- [seqr.lisp](sw/rsc3/help/graph/seqr.lisp) +- [shepard-tones.lisp](sw/rsc3/help/graph/shepard-tones.lisp) +- [shifting-pulses.lisp](sw/rsc3/help/graph/shifting-pulses.lisp) +- [slly-wlk.lisp](sw/rsc3/help/graph/slly-wlk.lisp) +- [snare-909.lisp](sw/rsc3/help/graph/snare-909.lisp) +- [sosc-lp.lisp](sw/rsc3/help/graph/sosc-lp.lisp) +- [spe.lisp](sw/rsc3/help/graph/spe.lisp) +- [sprinkler.lisp](sw/rsc3/help/graph/sprinkler.lisp) +- [sprinkler-mouse.lisp](sw/rsc3/help/graph/sprinkler-mouse.lisp) +- [status.lisp](sw/rsc3/help/graph/status.lisp) +- [strtchd-scrmbld.lisp](sw/rsc3/help/graph/strtchd-scrmbld.lisp) +- [strummable-guitar.lisp](sw/rsc3/help/graph/strummable-guitar.lisp) +- [sweepy-noise.lisp](sw/rsc3/help/graph/sweepy-noise.lisp) +- [swept-resonant-noise.lisp](sw/rsc3/help/graph/swept-resonant-noise.lisp) +- [synthetic-piano.lisp](sw/rsc3/help/graph/synthetic-piano.lisp) +- [tank.lisp](sw/rsc3/help/graph/tank.lisp) +- [tgb.lisp](sw/rsc3/help/graph/tgb.lisp) +- [tgr-rpr.lisp](sw/rsc3/help/graph/tgr-rpr.lisp) +- [theremin.lisp](sw/rsc3/help/graph/theremin.lisp) +- [three-cpsw.lisp](sw/rsc3/help/graph/three-cpsw.lisp) +- [tipnso.lisp](sw/rsc3/help/graph/tipnso.lisp) +- [tremulate.lisp](sw/rsc3/help/graph/tremulate.lisp) +- [trkl.lisp](sw/rsc3/help/graph/trkl.lisp) +- [trmlo.lisp](sw/rsc3/help/graph/trmlo.lisp) +- [tr-out.lisp](sw/rsc3/help/graph/tr-out.lisp) +- [tsort.lisp](sw/rsc3/help/graph/tsort.lisp) +- [uplink.lisp](sw/rsc3/help/graph/uplink.lisp) +- [voscil.lisp](sw/rsc3/help/graph/voscil.lisp) +- [what-was-i-thinking.lisp](sw/rsc3/help/graph/what-was-i-thinking.lisp) +- [why-supercollider.lisp](sw/rsc3/help/graph/why-supercollider.lisp) +- [wial.lisp](sw/rsc3/help/graph/wial.lisp) +- [wind-metals.lisp](sw/rsc3/help/graph/wind-metals.lisp) +- [xy-interference.lisp](sw/rsc3/help/graph/xy-interference.lisp) +- [zizle.lisp](sw/rsc3/help/graph/zizle.lisp) + +## LISP + +- [hsc3.lisp](?t=hsc3-lisp&e=lisp/hsc3.lisp) +- [rhs.lisp](?t=hsc3-lisp&e=lisp/rhs.lisp) +- [rhs.syntaxlisp](?t=hsc3-lisp&e=lisp/rhs.syntax.lisp) +- [rsc3.lisp](?t=hsc3-lisp&e=lisp/rsc3.lisp) +- [scheme.lisp](?t=hsc3-lisp&e=lisp/scheme.lisp) +- [stdlib.lisp](?t=hsc3-lisp&e=lisp/stdlib.lisp) +- [ugen.lisp](?t=hsc3-lisp&e=lisp/ugen.lisp) + +## HELP + +- [jmcc.lisp](?t=hsc3-lisp&e=help/jmcc.lisp) +- [tutorial.lisp](?t=hsc3-lisp&e=help/tutorial.lisp) +- [r5rs.lisp](?t=hsc3-lisp&e=help/r5rs.lisp) + +© [rohan drape][rd], 2014, [gpl][gpl]. + +[rd]: http://rd.slavepianos.org/ +[hsc3]: http://rd.slavepianos.org/?t=hsc3 +[hs]: http://haskell.org/ +[sc3]: http://audiosynth.com/ +[gpl]: http://gnu.org/copyleft/ +[emacs]: http://www.gnu.org/software/emacs/ +[lisp]: http://www-formal.stanford.edu/jmc/history/lisp/lisp.html +[rsc3]: http://rd.slavepianos.org/?t=rsc3 +[scheme]: http://library.readscheme.org/standards.html + +[r4rs]: http://people.csail.mit.edu/jaffer/r4rs_toc.html +[r5rs]: http://www.schemers.org/Documents/Standards/R5RS/HTML/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hs/hsc3-lisp.hs b/hs/hsc3-lisp.hs new file mode 100644 --- /dev/null +++ b/hs/hsc3-lisp.hs @@ -0,0 +1,169 @@ +import Control.Monad.Except {- mtl -} +import Data.Char {- base -} +import qualified Data.Map as M {- containers -} +import Data.Maybe {- base -} +import Safe {- safe -} +import System.Environment {- base -} + +import Sound.OSC {- hsc3 -} +import Sound.SC3 {- hsc3 -} +import Sound.SC3.UGen.Plain {- hsc3 -} +import Sound.SC3.UGen.PP {- hsc3 -} + +import Sound.SC3.UGen.Dot {- hsc3-dot -} + +import Lisp + +ugen_to_int :: String -> UGen -> Int +ugen_to_int c u = + let err = error ("UGEN_TO_INT: " ++ c ++ ": " ++ show u) + f = floor . fromMaybe err . u_constant + in f u + +instance Lisp_Ty UGen where + ty_show = ugen_concise_pp + ty_to_int = ugen_to_int "TY_TO_INT" + ty_from_bool t = if t then 1 else 0 + +lift_io :: IO () -> VM a (Cell a) +lift_io f = liftIO f >> return Nil + +constant_err :: Cell UGen -> Double +constant_err c = + case fmap constant_opt (atom c) of + Just (Just n) -> n + _ -> error "NOT CONSTANT?" + +ugen_to_double :: String -> UGen -> Double +ugen_to_double c u = + let err = error ("UGEN_TO_DOUBLE: " ++ c ++ ": " ++ show u) + f = fromMaybe err . u_constant + in f u + +l_mk_ugen :: Cell UGen -> VM UGen (Cell UGen) +l_mk_ugen c = do + let l = to_list c + [nm,rt,inp,inp_mce,outp,sp,k] <- if length l == 7 then return l else throwError ("MK-UGEN: INCORRECT INPUT: " ++ show c) + inp_mce' <- case inp_mce of + Atom u -> return (mceChannels u) + Nil -> return [] + _ -> throwError ("MK-UGEN: MCE-INPUT: " ++ show inp_mce) + sp' <- case sp of + Atom u -> return (Special (ugen_to_int "SPECIAL" u)) + Nil -> return (Special 0) + _ -> throwError "MK-UGEN: SPECIAL?" + k' <- case k of + Atom u -> return (UId (ugen_to_int "UID" u)) + Nil -> return NoId + _ -> throwError "MK-UGEN: UID?" + inp' <- fmap (++ inp_mce') (mapM atom_err (to_list inp)) + rt' <- case rt of + Symbol sym -> return (fromJust (rate_parse (map toUpper sym))) + Cons _ _ -> do + let f = rateOf . atNote ("MK-UGEN: RATE: " ++ show c) inp' . ugen_to_int "RATE" + fmap maximum (mapM (fmap f . atom_err) (to_list rt)) + _ -> throwError ("MK-UGEN: RATE: " ++ show rt) + nm' <- case nm of + String str -> return str + _ -> throwError ("MK-UGEN: NAME NOT STRING: " ++ show nm) + let outp' = floor (constant_err outp) + return (Atom (ugen_optimise_const_operator (mk_plain rt' nm' inp' outp' sp' k'))) + +l_is_number :: Cell UGen -> Cell UGen +l_is_number c = + case c of + Atom u -> if isConstant u then l_true else l_false + _ -> l_false + +l_is_procedure :: Cell UGen -> Cell UGen +l_is_procedure c = + case c of + Fun _ -> l_true + Proc _ -> l_true + Lambda _ _ _ -> l_true + Macro _ -> l_true + _ -> l_false + +l_clone_star :: Cell UGen -> VM UGen (Cell UGen) +l_clone_star c = + case to_list c of + [Atom k,Atom n,Atom u] -> + let k' = ugen_to_int "CLONE-K" k + n' = ugen_to_int "CLONE-N" n + in return (Atom (uclone k' n' u)) + _ -> throwError ("clone*: " ++ show c) + +l_play_at_star :: Cell UGen -> VM UGen (Cell UGen) +l_play_at_star c = + case to_list c of + [_,Atom u,Atom nid,Atom act,Atom grp] -> + let nid' = ugen_to_int "PLAY-AT: NID" nid + act' = ugen_to_int "PLAY-AT: ACT" act + grp' = ugen_to_int "PLAY-AT: GRP" grp + in lift_io (withSC3 (play_at (nid',toEnum act',grp') u)) >> + return Nil + _ -> throwError ("play-at*: " ++ show c) + +l_thread_sleep :: Cell UGen -> VM UGen (Cell UGen) +l_thread_sleep c = do + u <- atom_err c + liftIO (pauseThread (ugen_to_double "pause" u)) + return Nil + +cell_to_datum :: Cell UGen -> VM a Datum +cell_to_datum c = + case c of + Symbol str -> return (string str) + String str -> return (string str) + Atom (Constant_U (Constant n)) -> return (float n) + _ -> throwError ("CELL-TO-DATUM: " ++ show c) + +cell_to_message :: Cell UGen -> VM a Message +cell_to_message c = + case to_list' c of + Just (String addr : l) -> mapM cell_to_datum l >>= \l' -> return (Message addr l') + _ -> throwError ("CELL-TO-MESSAGE: " ++ show c) + +l_async_star :: Cell UGen -> VM a (Cell a) +l_async_star c = cell_to_message c >>= \c' -> lift_io (withSC3 (void (async c'))) + +l_send_star :: Cell UGen -> VM a (Cell a) +l_send_star c = cell_to_message c >>= \c' -> lift_io (withSC3 (void (send c'))) + +ugen_dict :: Dict UGen +ugen_dict = + M.fromList + [("number?",Fun l_is_number) + ,("string?",Fun (\c -> case c of {String _ -> l_true; _ -> l_false})) + ,("symbol?",Fun (\c -> case c of {Symbol _ -> l_true; _ -> l_false})) + ,("procedure?",Fun l_is_procedure) + ,("mk-ugen",Proc l_mk_ugen) + ,("clone*",Proc l_clone_star) + ,("make-mce",Proc (\c -> fmap (Atom . mce) (mapM atom_err (to_list c)))) + ,("mce-channels",Proc (\c -> fmap (from_list . map Atom . mceChannels) (atom_err c))) + ,("make-mrg*",Proc (\c -> fmap (Atom . mrg) (mapM atom_err (to_list c)))) + ,("show-graph",Proc (\c -> atom_err c >>= \u -> lift_io (draw (out 0 u)))) + ,("play-at*",Proc l_play_at_star) + ,("reset*",Proc (\_ -> lift_io (withSC3 reset))) + ,("thread-sleep",Proc l_thread_sleep) + ,("utcr",Proc (\_ -> liftIO time >>= return . Atom . constant)) + ,("display-server-status",Proc (\_ -> lift_io (withSC3 serverStatus >>= mapM_ putStrLn))) + ,("async*",Proc l_async_star) + ,("send*",Proc l_send_star) + ,("unrand",Proc (\c -> atom_err c >>= \u -> return (Atom (ugen_optimise_ir_rand u))))] + +main :: IO () +main = do + putStrLn "HSC3-LISP" + env <- gen_toplevel (M.unions [core_dict,ugen_dict]) :: IO (Env UGen) + let lib = ["stdlib.lisp" + ,"scheme.lisp" + ,"rhs.lisp" -- sw/rhs + ,"rhs.syntax.lisp" + ,"rsc3.prereq.lisp" + ,"ugen.lisp" -- sw/rsc3 + ,"hsc3.lisp" + ,"rsc3.lisp" -- sw/rsc3 + ] + a <- getArgs + repl env (load_files (lib ++ a)) diff --git a/hsc3-lisp.cabal b/hsc3-lisp.cabal new file mode 100644 --- /dev/null +++ b/hsc3-lisp.cabal @@ -0,0 +1,37 @@ +Name: hsc3-lisp +Version: 0.15 +Synopsis: LISP SUPERCOLLIDER +Description: LISP SUPERCOLLIDER +License: GPL +Category: Sound +Copyright: (c) Rohan Drape, 2014 +Author: Rohan Drape +Maintainer: rd@slavepianos.org +Stability: Experimental +Homepage: http://rd.slavepianos.org/t/hsc3-lisp +Tested-With: GHC == 7.8.2 +Build-Type: Simple +Cabal-Version: >= 1.8 + +Data-files: README + +executable hsc3-lisp + build-depends: base == 4.*, + containers, + directory, + filepath, + hashable, + husk-scheme, + hosc == 0.15.*, + hsc3 == 0.15.*, + hsc3-dot == 0.15.*, + mtl, + safe, + unix + hs-source-dirs: hs + main-is: hsc3-lisp.hs + ghc-options: -Wall -fno-warn-orphans -fwarn-tabs + +Source-Repository head + Type: darcs + Location: http://rd.slavepianos.org/sw/hsc3-lisp/