288 lines
9 KiB
Racket
Executable file
288 lines
9 KiB
Racket
Executable file
#! /usr/bin/env racket
|
|
#lang racket
|
|
|
|
;; Parse .schelp.scm files and convert to .scrbl
|
|
;;
|
|
;; Copyright (C) 2022 FoAM
|
|
;;
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see http://www.gnu.org/licenses/
|
|
|
|
|
|
;; Author(s)
|
|
;; - nik gaffney <nik@fo.am>
|
|
|
|
|
|
;; Commentary
|
|
;;
|
|
;; (schelp -> scm ) -> racket (scribble)
|
|
;; This is a q&d parser to convert .help.scm files as seen in rsc3
|
|
;; to something usable as part of the racket documentation system
|
|
;; which uses the scribble format as described at
|
|
;; https://docs.racket-lang.org/scribble/index.html
|
|
;;
|
|
;; partially complete. partially automated.
|
|
|
|
|
|
(require parsack)
|
|
|
|
;; cli options
|
|
(define filename (make-parameter ""))
|
|
(define verbose? (make-parameter #f))
|
|
;; help is relative (or not at all)
|
|
(define help-path (make-parameter
|
|
(path->string (current-directory))))
|
|
|
|
(define getopt
|
|
(command-line
|
|
#:program "scm2scrbl"
|
|
#:once-each
|
|
(("-v" "--verbose") "various verbose messages" (verbose? #t))
|
|
(("-p" "--help-path") folder "path to the directory containing help files" (help-path folder))
|
|
#:args (input-file)
|
|
(filename input-file)
|
|
(if (file-exists? (filename))
|
|
(printf "Converting .help.scm to scribble: ~a\n" (filename))
|
|
(raise-user-error 'scm2scrbl "File '~a' does not exist." (filename)))))
|
|
|
|
;; echoing verbosity
|
|
(define-syntax verbose
|
|
(syntax-rules ()
|
|
((verbose str ...) (when (verbose?) (printf str ...)))))
|
|
|
|
|
|
;; parsack parser for base case, assuming well formatted input...
|
|
;; - fragile and error prone
|
|
;; - assume first line is title
|
|
;; - all comments are considered 'text'
|
|
;; - any code is wrapped in a racketblock
|
|
;; - multiline examples
|
|
;; - minimal xref info
|
|
|
|
|
|
;; title as first comment line
|
|
(define $title
|
|
(<?> (parser-compose
|
|
(manyTill (char #\;) $space) ;; assume a space separation
|
|
(x <- (manyTill $anyChar $eol))
|
|
(return (format-title x)))
|
|
"title"))
|
|
|
|
;; s-expressions (not strictly, but...)
|
|
(define $sexp
|
|
(<?> (parser-seq
|
|
(char #\() (many (<or> $sexp (and $anyChar (noneOf "()")))) (char #\)))
|
|
"sexp"))
|
|
|
|
;; text as any scheme comment line
|
|
(define $text-terminator (<?> $eol "text terminator"))
|
|
|
|
(define $text-line
|
|
(<?> (parser-compose
|
|
(parser-seq (many1 (char #\;)) $space) ;; assume a space separation of comments
|
|
(x <- (manyUntil $anyChar $text-terminator))
|
|
(return (format-text x)))
|
|
"text"))
|
|
|
|
;; block comment
|
|
(define $text-block
|
|
(<?> (parser-compose
|
|
(string "#|")
|
|
(x <- (many (and $anyChar (<!> (try (char #\|))))))
|
|
(string "|#")
|
|
(return (format-text x)))
|
|
"text"))
|
|
|
|
;; blank line
|
|
(define $blank (<?> (<any> $newline $space $eol) "blank line"))
|
|
|
|
;; code block formatting
|
|
(define $code
|
|
(<?> (parser-seq $sexp #:combine-with format-racketblock) "code"))
|
|
|
|
;; a help file usually starts with a one line function followed by a new line
|
|
;; then either text blocks (as comments) and/or example code.
|
|
|
|
(define $help-file
|
|
(parser-seq
|
|
$title
|
|
(many (<any> $code $text-line $text-block $blank))
|
|
$eof))
|
|
|
|
;; parser -> string -> string
|
|
(define (parse->string p s)
|
|
(string-append (parse-result p s)))
|
|
|
|
;; scribbling & formatting
|
|
|
|
;; any header or footer info required for the scribble file
|
|
(define scribble-preamble
|
|
"#lang scribble/manual\n@(require (for-label racket))")
|
|
|
|
(define scribble-postamble "")
|
|
|
|
;; wrap codeblock
|
|
(define (format-racketblock a . z)
|
|
(verbose "format racket block: ~a~n" (cons a z))
|
|
(format "~n@racketblock[~n~a~n]" (format-result (cons a z))))
|
|
|
|
;; wrap title
|
|
(define (format-title s)
|
|
(verbose "format title: ~a~n" s)
|
|
(format "~n@title{~a}~n~n" (string-trim (list->string s))))
|
|
|
|
;; generic text
|
|
(define (format-text s)
|
|
(verbose "format text: ~a~n" s)
|
|
(format "~a~n" (list->string s)))
|
|
|
|
(define (format-result l)
|
|
(verbose "formatting result: ~s~n" l)
|
|
(foldl (lambda (e acc)
|
|
(cond
|
|
((string? e) (string-append acc e))
|
|
((char? e) (string-append acc (~a e )))
|
|
(else (verbose "~nunformatted?: ~n" e))))
|
|
""
|
|
(flatten l)))
|
|
|
|
;; parse a .help.scm file into formatted string
|
|
(define (parse-help-file f)
|
|
(let* ((path (build-path (help-path) f))
|
|
(body (port->string
|
|
(open-input-file path))))
|
|
(verbose "parsing file: ~a~n" path)
|
|
(format-result
|
|
(parse-result $help-file body))))
|
|
|
|
|
|
;; read a help file, write a scribble file
|
|
(define (read-write-scribble f)
|
|
(let ((body (parse-help-file f))
|
|
(path (string-replace
|
|
(string-append (help-path) f) ".scm" ".scrbl")))
|
|
(verbose "writing file: ~a~n" path)
|
|
(with-output-to-file
|
|
#:exists 'replace
|
|
path
|
|
(lambda ()
|
|
(printf "~a~n" scribble-preamble)
|
|
(printf "~a~n" body)
|
|
(printf "~a~n" scribble-postamble)))))
|
|
|
|
;; testing
|
|
(define sc0 ";; (demand-env-gen rate levels times shapes curves gate reset levelScale levelOffset timeScale doneAction)
|
|
|
|
;; levels - a demand ugen or any other ugen
|
|
|
|
;; times - a demand ugen or any other ugen if one of these ends,
|
|
;; the doneAction is evaluated
|
|
|
|
;; shapes - a demand ugen or any other ugen, the number given is
|
|
;; the shape number according to Env
|
|
|
|
;; curves - a demand ugen or any other ugen, if shape is 5, this
|
|
;; is the curve factor some curves/shapes don't work if
|
|
;; the duration is too short. have to see how to improve
|
|
;; this. also some depend on the levels obviously, like
|
|
;; exponential cannot cross zero.
|
|
|
|
;; gate - if gate is x >= 1, the ugen runs, if gate is 0 > x > 1,
|
|
;; the ugen is released at the next level (doneAction), if
|
|
;; gate is x < 0, the ugen is sampled end held
|
|
|
|
;; reset - if reset crosses from nonpositive to positive, the ugen
|
|
;; is reset at the next level, if it is > 1, it is reset
|
|
;; immediately.
|
|
|
|
;; Frequency envelope with random times.
|
|
|
|
(let* ((l (dseq dinf (make-mce (list 204 400 201 502 300 200))))
|
|
(t (drand dinf (make-mce (list 1.01 0.2 0.1 2.0))))
|
|
(y (mouse-y kr 0.01 3 1 0.1))
|
|
(f (demand-env-gen ar l (mul t y) 7 0 1 1 1 0 1 do-nothing)))
|
|
(audition (out 0 (mul (sin-osc ar (mul f (mce2 1 1.01)) 0) 0.1))))
|
|
|
|
;; Frequency modulation
|
|
|
|
(let* ((x (mouse-x kr -0.01 -4 0 0.1))
|
|
(y (mouse-y kr 1 3000 1 0.1))
|
|
(l (lambda () (dseq dinf (clone 32 (exp-rand 200 1000)))))
|
|
(t (mul sample-dur y))
|
|
(f (demand-env-gen ar (mce2 (l) (l)) t 5 x 1 1 1 0 1 do-nothing)))
|
|
(audition (out 0 (mul (sin-osc ar f 0) 0.1))))
|
|
|
|
;; gate. Mouse x on right side of screen toggles gate.
|
|
|
|
(let* ((x (mouse-x kr 0 1 0 0.1))
|
|
(l (u:round (dwhite dinf 300 1000) 100))
|
|
(f (demand-env-gen kr l 0.1 5 0.3 (gt x 0.5) 1 1 0 1 do-nothing)))
|
|
(audition (out 0 (mul (sin-osc ar (mul f (mce2 1 1.21)) 0) 0.1))))
|
|
")
|
|
|
|
(define ss0 "(let* ((x (mouse-x kr -0.01 -4 0 0.1))
|
|
(y (mouse-y kr 1 3000 1 0.1))
|
|
(l (lambda () (dseq dinf (clone 32 (exp-rand 200 1000)))))
|
|
(t (mul sample-dur y))
|
|
(f (demand-env-gen ar (mce2 (l) (l)) t 5 x 1 1 1 0 1 do-nothing)))
|
|
(audition (out 0 (mul (sin-osc ar f 0) 0.1))))
|
|
")
|
|
|
|
(define bc0 ";; (pv-jensen-andersen buffer propsc prophfe prophfc propsf threshold waittime)
|
|
|
|
#|
|
|
|
|
fft feature detector for onset detection based on work described in
|
|
Jensen,K. & Andersen, T. H. (2003). Real-time Beat Estimation Using
|
|
Feature Extraction. in Proceedings of the Computer Music Modeling and
|
|
Retrieval Symposium, Lecture Notes in Computer Science. springer
|
|
Verlag.
|
|
|
|
First order derivatives of the features are taken. Threshold may
|
|
need to be set low to pick up on changes.
|
|
|
|
buffer - fft buffer to read from.
|
|
propsc - Proportion of spectral centroid feature.
|
|
prophfe - Proportion of high frequency energy feature.
|
|
prophfc - Proportion of high frequency content feature.
|
|
propsf - Proportion of spectral flux feature.
|
|
threshold - Threshold level for allowing a detection
|
|
waittime - If triggered, minimum wait until a further frame can
|
|
cause another spot (useful to stop multiple detects on
|
|
heavy signals)
|
|
|
|
Default values in sclang are: propsc=0.25, prophfe=0.25,
|
|
prophfc=0.25, propsf=0.25, threshold=1.0, waittime=0.04.
|
|
|
|
|#
|
|
|
|
(with-sc3
|
|
(lambda (fd)
|
|
(async fd (b-alloc 0 2048 1))))
|
|
|
|
(let* ((source (sound-in 0))
|
|
(detect (pv-jensen-andersen (fft* 0 source)
|
|
0.25 0.25 0.25 0.25
|
|
(mouse-x kr 0.01 1.0 1 0.1)
|
|
0.04)))
|
|
(audition
|
|
(out 0 (mul (sin-osc ar (mce2 440 445) 0)
|
|
(decay (mul 0.1 detect) 0.1)))))
|
|
")
|
|
|
|
;(format-result (parse-result $code ss0))
|
|
|
|
;(format-result (parse-result $help-file sc0))
|
|
|
|
;; cli edition
|
|
(read-write-scribble (filename))
|